opentype 0.0.1 → 0.1.0

raw patch · 13 files changed

+1981/−119 lines, 13 filesdep +microlensdep +microlens-thdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens, microlens-th, mtl, unordered-containers

API changes (from Hackage documentation)

Files

• Opentype/Fileformat.hs +112/−20
• Opentype/Fileformat/Cmap.hs +5/−2
• Opentype/Fileformat/FontInfo.hs +568/−0
• Opentype/Fileformat/Glyph.hs +203/−64
• Opentype/Fileformat/Head.hs +7/−7
• Opentype/Fileformat/Hhea.hs +9/−9
• Opentype/Fileformat/Kern.hs +7/−3
• Opentype/Fileformat/Maxp.hs +3/−0
• Opentype/Fileformat/Name.hs +17/−7
• Opentype/Fileformat/Post.hs +2/−2
• Opentype/Fileformat/Unicode.hs +111/−0
• Opentype/Fileformat/Unicode/PostNames.hs +919/−0
• opentype.cabal +18/−5

@@ -1,4 +1,4 @@-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TupleSections, TemplateHaskell #-}  -- | This module provides opentype file loading and writing.  An -- attempt was made to have a higher level interface without@@ -6,22 +6,30 @@  module Opentype.Fileformat        (-- * Types-         ShortFrac (..), Fixed, FWord, UFWord, GlyphID,+         ShortFrac (..), Fixed, FWord, UFWord, GlyphID, WordMap,           -- * Main datatype-         OpentypeFont (..), maxpTable, glyfTable, OutlineTables (..), GenericTables,+         OpentypeFont (..), OutlineTables (..), GenericTables,+         -- ** OpentypeFont lenses+         _headTable, _hheaTable, _cmapTable,+         _nameTable, _postTable, _os2Table, _kernTable, _outlineTables, _otherTables,+         _maxpTable, _glyfTable,           -- * IO          readOTFile, writeOTFile,          -- * Head table          HeadTable(..),          -- * Glyf table-         GlyfTable(..), Glyph(..), GlyphOutlines(..),+         GlyfTable(..), Glyph(..), StandardGlyph, GlyphOutlines(..), getScaledContours,+         emptyGlyfTable,          CurvePoint(..), Instructions, GlyphComponent(..),+         -- ** Glyf table lenses+         _glyphContours, _glyphInstructions, _glyphComponents,          -- * CMap table          CmapTable(..), CMap(..), PlatformID(..), MapFormat (..),+         emptyCmapTable,           -- * Hhea table          HheaTable(..),          -- * Maxp table-         MaxpTable(..),+         MaxpTable(..), emptyMaxpTable,          -- * Name table          NameTable(..), NameRecord(..),          -- * Post table@@ -29,7 +37,7 @@          -- * OS/2 table          OS2Table(..),          -- * Kern table-         KernTable(..), KernPair(..)+         KernTable(..), KernPair(..), _kernPairs        ) where import Opentype.Fileformat.Types import Opentype.Fileformat.Head@@ -53,6 +61,10 @@ import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString as Strict import Data.ByteString.Unsafe+import Lens.Micro hiding (strict)+import Lens.Micro.TH+import Lens.Micro.Extras+import qualified Data.Vector as V import qualified Data.Map as M  type GenericTables = M.Map String Lazy.ByteString@@ -82,21 +94,21 @@   }   deriving Show + -- | tables for quadratic outlines (truetype or opentype) data OutlineTables =   QuadTables MaxpTable GlyfTable |   CubicTables    deriving Show -maxpTable :: OpentypeFont -> Maybe MaxpTable-maxpTable font = case outlineTables font of-  QuadTables m _ -> Just m-  _ -> Nothing--glyfTable :: OpentypeFont -> Maybe GlyfTable-glyfTable font = case outlineTables font of-  QuadTables _ g -> Just g-  _ -> Nothing+makeLensesFor [("headTable", "_headTable"),+               ("hheaTable", "_hheaTable"),+               ("cmapTable", "_cmapTable"),+               ("nameTable", "_nameTable"),+               ("postTable", "_postTable"),+               ("outlineTables", "_outlineTables"),+               ("otherTables", "_otherTables")]+               ''OpentypeFont  data ScalerType =   -- opentype with cff@@ -110,6 +122,50 @@ type SfntLocs = M.Map Scaler (Word32, Word32) type Scaler = Word32 +_maxpTable :: Traversal' OpentypeFont MaxpTable+_maxpTable f font = case outlineTables font of+  QuadTables m g -> (\m2 -> font { outlineTables = QuadTables m2 g })+                    <$> f m+  _ -> pure font++_glyfTable :: Traversal' OpentypeFont GlyfTable+_glyfTable f font = case outlineTables font of+  QuadTables m g -> (\g2 -> font {outlineTables = QuadTables m g2})+                    <$> f g+  _ -> pure font++_os2Table :: Traversal' OpentypeFont OS2Table+_os2Table f font = case os2Table font of+  Just t -> (\t2 -> font {os2Table = Just t2}) <$> f t+  Nothing -> pure font++_kernTable :: Traversal' OpentypeFont KernTable+_kernTable f font = case kernTable font of+  Just t -> (\t2 -> font {kernTable = Just t2}) <$> f t+  Nothing -> pure font++-- | @getScaledContours scaleOffset glyfTable glyph@: Get the scaled+-- contours for a simple or composite glyph.+getScaledContours :: OpentypeFont -> StandardGlyph -> [[CurvePoint]]+getScaledContours font glyph =+  case preview _glyfTable font of+    Nothing -> []+    Just (GlyfTable vec) ->+      getScaledContours' 10 (appleScaler font) vec glyph++getWindowsMap :: OpentypeFont -> Maybe CMap+getWindowsMap font =+  find (\cm -> cmapPlatform cm == MicrosoftPlatform &&+               cmapEncoding cm `elem` [0, 1]) $+  getCmaps $ cmapTable font+  +getUnicodeChar :: OpentypeFont -> Word32 -> Maybe (Glyph Int)+getUnicodeChar font c = do+  mp <- getWindowsMap font+  gID <- fmap fromIntegral $ M.lookup c $ glyphMap mp+  (V.!? gID) =<< glyphVector <$>+    preview _glyfTable font+ -- | write an opentype font to a file writeOTFile :: OpentypeFont -> FilePath -> IO () writeOTFile font file = @@ -117,16 +173,31 @@     CubicTables ->       error "cubic splines are not yet supported"     QuadTables maxpTbl (GlyfTable glyphs) ->-       let (lengths, glyphBs) = runPutM $ writeGlyphs glyphs+       let (lengths, glyphBs) = runPutM $ writeGlyphs (appleScaler font) glyphs            (format, locaBs) = runPutM $ writeLoca lengths            (longHor, hmtxBs) = runPutM $ writeHmtx glyphs-           head2 = updateHead glyphs $-                   (headTable font) {+           (xmin, ymin, xmax, ymax, _avgWdt) = getMinMax glyphs+           head2 = (headTable font) {                      headVersion = 0x00010000,+                     xMin = xmin,+                     yMin = ymin,+                     xMax = xmax,+                     yMax = ymax,                      fontDirectionHint = 2,                      longLocIndices = format }+           theAscent | ascent (hheaTable font) == 0 = fromIntegral ymax+                     | otherwise = ascent (hheaTable font)+           theDescent | descent (hheaTable font) == 0 = fromIntegral ymin+                      | otherwise = descent (hheaTable font)+           theLineGap = case os2Table font of+             Just os2 -> fromIntegral (unitsPerEm head2) + sTypoLineGap os2 -+                         ascent hhea2 + descent hhea2+             Nothing -> lineGap (hheaTable font)            hhea2 = updateHhea glyphs $-                   (hheaTable font) {numOfLongHorMetrics = fromIntegral longHor}+                   (hheaTable font) {numOfLongHorMetrics = fromIntegral longHor,+                                     ascent = theAscent,+                                     descent= theDescent,+                                     lineGap= theLineGap}            maxp2 = updateMaxp glyphs $                    maxpTbl {maxpVersion = 0x00010000}            headBs = Lazy.toStrict $ runPut $ putHeadTable head2@@ -135,7 +206,28 @@            maxpBs = Lazy.toStrict $ runPut $ putMaxpTable maxp2             nameBs = Lazy.toStrict $ runPut $ putNameTable $ nameTable font            postBs = Lazy.toStrict $ runPut $ putPostTable $ postTable font-           os2Bs  = (Lazy.toStrict . runPut . putOS2Table) <$> os2Table font+           os2Bs  = (Lazy.toStrict . runPut . putOS2Table .+                      (\os2 -> os2 {+                          usWinAscent = fromIntegral theAscent,+                          usWinDescent = fromIntegral $ -theDescent,+                          usFirstCharIndex = fromMaybe 0 $ do+                              mp <- getWindowsMap font+                              Just $ fromIntegral $ fst $ M.findMin $ glyphMap mp,+                          usLastCharIndex = fromMaybe 0xffff $ do+                              mp <- getWindowsMap font+                              let l = fst $ M.findMax $ glyphMap mp+                              if l > 0xffff then Nothing else Just $ fromIntegral l,+                          sxHeight =+                              if sxHeight os2 == 0+                              then fromMaybe 0 $+                                   glyphYmax <$> getUnicodeChar font 0x0078+                              else sxHeight os2,+                          sCapHeight =+                              if sCapHeight os2 == 0+                              then fromMaybe 0 $+                                   glyphYmax <$> getUnicodeChar font 0x0048+                              else sCapHeight os2}))+                    <$> os2Table font            kernBs = (Lazy.toStrict . runPut . putKernTable) <$> kernTable font            scaler | appleScaler font = AppleScaler                    | otherwise = QuadScaler

@@ -63,9 +63,12 @@ -- * 5: Johab -- * 10: Unicode UCS-4 -data CmapTable = CmapTable [CMap]+newtype CmapTable = CmapTable {getCmaps :: [CMap]}   deriving Show +emptyCmapTable :: CmapTable+emptyCmapTable = CmapTable []+ data CMap = CMap {   cmapPlatform :: PlatformID,   cmapEncoding :: Word16,@@ -351,7 +354,7 @@       size, segCount, searchRange, entrySelector :: Word16       entrySelector = iLog2 segCount       searchRange = 1 `shift` (fromIntegral $ entrySelector+1)-      segments = getSegments $ M.toList $ glyphMap cmap+      segments = getSegments $ M.toList $ subIntMap 0 0xffff $ glyphMap cmap       (codeSize, layout) = mapAccumL foldLayout (segCount*2) segments       foldLayout offset (RangeSegment start len code) =         (offset-2, Segment4layout (fromIntegral $ start+len-1)

@@ -0,0 +1,568 @@+-- | This module implements a somewhat more logical structure+-- containing font information, without the need for an in-depth study+-- of the opentype spec.+module Opentype.Fileformat.FontInfo (FontInfo(..), Weight(..),+                                     Width(..), Slant(..), Decoration(..),+                                     EmbedLicence(..), infoToTables)+where+import Opentype.Fileformat+import Opentype.Fileformat.Types+import Data.Maybe+import Data.Word+import Data.Time+import Data.Char+import Data.Bits+import Data.Binary.Put+import Data.Foldable+import Text.Printf+import Lens.Micro+import Lens.Micro.Extras+import qualified Data.ByteString.Lazy as Lazy+import qualified Data.ByteString as Strict++data Weight = Thin | ExtraLight | Light | NormalWeight | MediumWeight+            | SemiBold | Bold | ExtraBold | Heavy+            deriving (Eq, Ord)++instance Show Weight where+  show Thin = "Thin"+  show ExtraLight = "Extra Light"+  show Light = "Light"+  show NormalWeight = "Regular"+  show MediumWeight = "Medium"+  show SemiBold = "Semibold"+  show Bold = "Bold"+  show ExtraBold = "Extra Bold"+  show Heavy = "Heavy"++data Width = UltraCondensed | ExtraCondensed | Condensed | SemiCondensed+           | MediumWidth | SemiExpanded | Expanded | ExtraExpanded | UltraExpanded+           deriving (Eq, Ord)++instance Show Width where+  show UltraCondensed = "Ultra Condensed"+  show ExtraCondensed = "Extra Condensed"+  show Condensed = "Condensed"+  show SemiCondensed = "Semi Condensed"+  show MediumWidth = "Regular"+  show SemiExpanded = "Semi Expanded"+  show Expanded = "Expanded"+  show ExtraExpanded = "Extra Expanded"+  show UltraExpanded = "Ultra Expanded"+  +data Slant = Italic | Oblique | NoSlant+  deriving Eq++instance Show Slant where+  show Italic = "Italic"+  show Oblique = "Oblique"+  show NoSlant = "Regular"++data Decoration = Underscore | Negative | Outlined | StrikeOut | Shadow+  deriving Eq++data EmbedLicence =+  -- | Fonts must not be modified, embedded or exchanged in any manner+  -- without first obtaining permission of the legal owner.  Caution:+  -- For Restricted License embedding to take effect, it must be the+  -- only level of embedding selected.+  RestrictedEmbedding |+  -- | The font may be embedded, and temporarily loaded on the remote+  -- system. Documents containing Preview & Print fonts must be opened+  -- “read-only;” no edits can be applied to the document.+  PrintPreview |+  -- | The font may be embedded but must only be installed temporarily+  -- on other systems. In contrast to Preview & Print fonts, documents+  -- containing Editable fonts may be opened for reading, editing is+  -- permitted, and changes may be saved.+  EditEmbed |+  -- | When this bit is set, the font may not be subsetted prior to+  -- embedding. Other embedding restrictions also apply.+  NoSubsetEmbed |+  -- | When this bit is set, only bitmaps contained in the font may be+  -- embedded. No outline data may be embedded. If there are no+  -- bitmaps available in the font, then the font is considered+  -- unembeddable and the embedding services will fail. Other+  -- embedding restrictions specified in bits 0-3 and 8 also apply.+  OnlyBitmapEmbed++licenceBit :: EmbedLicence -> Int+licenceBit RestrictedEmbedding = 0x0002+licenceBit PrintPreview = 0x0004+licenceBit EditEmbed = 0x0008+licenceBit NoSubsetEmbed = 0x0100+licenceBit OnlyBitmapEmbed = 0x0200++embeddedBits :: [EmbedLicence] -> Word16+embeddedBits = fromIntegral . sum . map licenceBit++-- |  Currently only english strings are supported.+data FontInfo = FontInfo {+  -- | Font Family name, without subfamily classifiers such as /Bold/, /Italic/, etc...+  fontFamily :: String,+  -- | Font version, multiplied by 1000, for example use 1500 for+  -- version 1.5+  fontVersion :: Int,+  -- | Number of units in an em-square.  Should be a power of 2.+  -- Typical values are 1024 or 2048.+  fontUnitsPerEm :: FWord,+  -- | Distance between the bottom of the em-square and the baseline+  -- in font design units.+  fontEmBase :: FWord,+  -- | Linegap in font design units.  Defined as distance between+  -- baselines - height of em square (`fontUnitsPerEm`).+  fontLineGap :: FWord,+  -- | Weight of the font.  /default/: `NormalWeight`+  fontWeight :: Weight,+  -- | Width of the font.  /default/: `MediumWidth`+  fontWidth :: Width,+  -- | Slant of the font.  /default/: `NoSlant`+  fontSlant :: Slant,+  -- | fixed width font.  /default/: False+  fontMonospaced :: Maybe Bool,+  -- | Smallest readable size in pixels.  /default/: 6+  fontLowestRecPPEM :: Maybe Int,+  -- | talic angle in counter-clockwise degrees from the+  -- vertical. Zero for upright text, negative for text that leans to+  -- the right (forward).  /default/: 0+  fontItalicAngle :: Maybe Double,+  -- | The amount by which a slanted highlight on a glyph needs to be+  -- shifted to produce the best appearance. /default/: 0+  fontCaretOffset :: Maybe FWord,+  -- | The recommended size in font design units for subscripts for+  -- this font. /default/: (fontUnitsPerEM/2, fontUnitsPerEM/2)+  fontSubScriptSize :: Maybe (FWord, FWord),+  -- | The recommended offset in font design units for subscripts for+  -- this font. /default/: (0, -fontUnitsPerEM/4)+  fontSubScriptOffset :: Maybe (FWord, FWord),+  -- | The recommended size in font design units for superscripts for+  -- this font. /default/: (fontUnitsPerEM/2, fontUnitsPerEM/2)+  fontSuperScriptSize :: Maybe (FWord, FWord),+  -- | The recommended offset in font design units for superscripts for+  -- this font. /default/: (cos(90 + italicAngle)*snd superscriptYOffset, (fontUnitsPerEM-fontEmBase)/2)+  fontSuperScriptOffset :: Maybe (FWord, FWord),+  -- | ndicates font embedding licensing rights for the+  -- font. Embeddable fonts may be stored in a document. When a+  -- document with embedded fonts is opened on a system that does not+  -- have the font installed (the remote system), the embedded font+  -- may be loaded for temporary (and in some cases, permanent) use on+  -- that system by an embedding-aware application. Embedding+  -- licensing rights are granted by the vendor of the font.+  -- /default/: []+  fontEmbeddingLicence :: [EmbedLicence],+  -- | Width of the strikeout stroke in font design units.  This field+  -- should normally be the width of the em dash for the current+  -- font. If the size is one, the strikeout line will be the line+  -- represented by the strikeout position field. If the value is two,+  -- the strikeout line will be the line represented by the strikeout+  -- position and the line immediately above the strikeout+  -- position. /default/: fontUnitsPerEm/20 +  fontStrikoutSize :: Maybe FWord,+  -- | The position of the top of the strikeout stroke relative to the+  -- baseline in font design units.  Positive values represent+  -- distances above the baseline, while negative values represent+  -- distances below the baseline. A value of zero falls directly on+  -- the baseline, while a value of one falls one pel above the+  -- baseline. The value of strikeout position should not interfere+  -- with the recognition of standard characters, and therefore should+  -- not line up with crossbars in the+  -- font. /default/. fontUnitsPerEm/5.5+  fontStrikeoutPosition :: Maybe FWord,+  -- | The font class and font subclass are registered values assigned+  -- by IBM to each font family. This parameter is intended for use in+  -- selecting an alternate font when the requested font is not+  -- available. The font class is the most general and the font+  -- subclass is the most specific. The high byte of this field+  -- contains the family class, while the low byte contains the family+  -- subclass. See <https://www.microsoft.com/typography/otspec/ibmfc.htm>+  -- for more information.+  -- /default/: (0,0)+  fontFamilyClass :: Maybe (Int, Int),+  -- | The four character identifier for the vendor of the given type+  -- face. This is not the royalty owner of the original artwork. This+  -- is the company responsible for the marketing and distribution of+  -- the typeface that is being classified. It is reasonable to assume+  -- that there will be 6 vendors of ITC Zapf Dingbats for use on+  -- desktop platforms in the near future (if not already). It is also+  -- likely that the vendors will have other inherent benefits in+  -- their fonts (more kern pairs, unregularized data, hand hinted,+  -- etc.). This identifier will allow for the correct vendor's type+  -- to be used over another, possibly inferior, font file. The Vendor+  -- ID value is not required.+  -- /default/: (' ', ' ', ' ', ' ')+  fontVendorID :: Maybe (Char, Char, Char, Char),+  -- | Panose-1 Classification.  /default/: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0)+  fontPanose :: Maybe (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int),+  -- | Supported Unicode Ranges: See+  -- https://www.microsoft.com/typography/otspec/os2.htm#ur.+  -- /default/ (3, 0, 0, 0)+  fontUnicodeRanges :: Maybe (Word32, Word32, Word32, Word32),+  -- | Supported Codepage Ranges. See+  -- https://www.microsoft.com/typography/otspec/os2.htm#cpr.+  -- /default/: (1, 0)+  fontCodepageRanges :: Maybe (Word32, Word32),+  -- | This metric specifies the distance between the baseline and the+  -- approximate height of non-ascending lowercase letters measured in+  -- FUnits.  /default/ height of glyph at U+0078 (LATIN SMALL LETTER+  -- X)+  fontXHeight :: Maybe FWord,+  -- | This metric specifies the distance between the baseline and the+  -- approximate height of uppercase letters measured in FUnits.+  -- /default/ height of glyph at U+0048 (LATIN CAPITAL LETTER H).+  fontCapHeight :: Maybe FWord,+  -- | This field is used for fonts with multiple optical styles.+  -- +  -- This value is the lower value of the size range for which this+  -- font has been designed. The units for this field are TWIPs+  -- (one-twentieth of a point, or 1440 per inch). The value is+  -- inclusive—meaning that that font was designed to work best at+  -- this point size through, but not including, the point size+  -- indicated by usUpperOpticalPointSize. When used with other+  -- optical fonts that set usLowerOpticalPointSize and+  -- usUpperOpticalPointSize, it would be expected that another font+  -- has this same value as this entry in the usUpperOpticalPointSize+  -- field, unless this font is designed for the lowest size+  -- range. The smallest font in an optical size set should set this+  -- value to 0.When working across multiple optical fonts, there+  -- should be no intentional gaps or overlaps in the+  -- ranges. usLowerOpticalPointSize must be less than+  -- usUpperOpticalPointSize. The maximum valid value is 0xFFFE.+  -- /default/: 0+  fontLowerOpticalPointSize :: Maybe Int,+  -- | fontUpperOptThis field is used for fonts with multiple optical styles.+  --+  -- This value is the upper value of the size range for which this+  -- font has been designed. The units for this field are TWIPs+  -- (one-twentieth of a point, or 1440 per inch). The value is+  -- exclusive—meaning that that font was designed to work best below+  -- this point size down to the usLowerOpticalPointSize+  -- threshold. When used with other optical fonts that set+  -- usLowerOpticalPointSize and usUpperOpticalPointSize, it would be+  -- expected that another font has this same value as this entry in+  -- the usLowerOpticalPointSize field, unless this font is designed+  -- for the highest size range. The largest font in an optical size+  -- set should set this value to 0xFFFF, which is interpreted as+  -- infinity. When working across multiple optical fonts, there+  -- should be no intentional or overlaps left in the+  -- ranges. usUpperOpticalPointSize must be greater than+  -- usLowerOpticalPointSize. The minimum valid value for this field+  -- is 2 (two). The largest possible inclusive point size represented+  -- by this field is 3276.65 points, any higher values would be+  -- represented as infinity.  /default/: 0xffff+  fontUpperOpticalPointSize :: Maybe Int,+  -- | This is the suggested distance of the top of the underline from+  -- the baseline (negative values indicate below baseline).  The+  -- PostScript definition of this FontInfo dictionary key (the y+  -- coordinate of the center of the stroke) is not used for+  -- historical reasons. The value of the PostScript key may be+  -- calculated by subtracting half the underlineThickness from the+  -- value of this field. /default/: /default/ -fontUnitsPerEm/8+  fontUnderlinePosition :: Maybe FWord,+  -- | suggested values for the underline thickness. /default/ fontUnitsPerEm/10+  fontUnderlineThickness :: Maybe FWord,+  -- | This field is used when the font has a subfamily other than+  -- Weight, Width or Slant.  Should not include any width, weight or+  -- slant descriptions. /default/: ""+  fontSubFamilyExtra :: String,+  -- | Set if the font has any of these decorations.  /default/: []+  fontDecoration :: [Decoration],+  -- | Copyright notice.  Default: []+  fontCopyright :: String,+  -- | Unique font identifier+  fontID :: String,+  -- | postscriptName.  /default/: full name with hyphen substituted for spaces.+  fontPsName :: String,+  -- | trademark. /default/: ""+  fontTrademark :: String,+  -- | Manufacturer Name.  /default/: ""+  fontManufacturer :: String,+  -- | name of the designer of the typeface.  /default/: ""+  fontDesigner :: String,+  -- | description of how the font may be legally used, or different+  -- example scenarios for licensed use. This field should be written+  -- in plain language, not legalese.  /default/: ""+  fontLicence :: String,+  -- | description of the typeface. Can contain revision information,+  -- usage recommendations, history, features, etc.+  fontDescription :: String,+  -- | URL where additional licensing information can be found.+  -- /default/ ""+  fontLicenceUrl :: String,+  -- | URL of typeface designer (with protocol, e.g., http://, ftp://).+  fontDesignerUrl :: String,+  -- | URL of font vendor (with protocol, e.g., http://, ftp://). If a+  -- unique serial number is embedded in the URL, it can be used to+  -- register the font.+  fontVendorUrl :: String,+  -- | This can be the font name, or any other text that the designer+  -- thinks is the best sample to display the font in.  /default/: ""+  fontSampleText :: String,+  -- | This ID, if used in the CPAL table’s Palette Labels Array,+  -- specifies that the corresponding color palette in the CPAL table+  -- is appropriate to use with the font when displaying it on a light+  -- background such as white. Name table strings for this ID specify+  -- the user interface strings associated with this+  -- palette. /default/ ""+  fontLightPalette :: String,+  -- | Dark Backgound Palette. This ID, if used in the CPAL table’s+  -- Palette Labels Array, specifies that the corresponding color+  -- palette in the CPAL table is appropriate to use with the font+  -- when displaying it on a dark background such as black. Name table+  -- strings for this ID specify the user interface strings associated+  -- with this palette+  fontDarkPalette :: String,+  -- | font creation time+  fontCreated :: UTCTime,+  -- | font modification time.  /default/: creation time.+  fontModified :: Maybe UTCTime+  }++weightClass :: Weight -> Word16+weightClass Thin = 100+weightClass ExtraLight = 200+weightClass Light = 300+weightClass NormalWeight = 400+weightClass MediumWeight = 500+weightClass SemiBold = 600+weightClass Bold = 700+weightClass ExtraBold = 800+weightClass Heavy = 900++widthClass :: Width -> Word16+widthClass UltraCondensed = 1+widthClass ExtraCondensed = 2+widthClass Condensed = 3+widthClass SemiCondensed = 4+widthClass MediumWidth = 5+widthClass SemiExpanded = 6+widthClass Expanded = 7+widthClass ExtraExpanded = 8+widthClass UltraExpanded = 9++(+++) :: String -> String -> String+s +++ "" = s+s +++ t = s ++ " " ++ t++notRegular :: (Show a, Eq a) => a -> a -> String+notRegular reg sub =+  if reg == sub then "" else show sub++(///) :: Maybe c -> c -> c+(///) = flip fromMaybe++-- | Fill in font information into the font tables+infoToTables :: FontInfo -> (HeadTable, HheaTable, NameTable, PostTable, OS2Table)+infoToTables fi = (headTbl, hheaTbl, nameTbl, postTbl, os2Tbl)+  where+    headTbl = HeadTable {+      headVersion = 0x00010000,+      fontRevision = fromIntegral $ +                     fromIntegral (fontVersion fi) * 0x00010000 `quot`+                     (1000 :: Integer),+      baselineYZero = True,+      sidebearingXZero = True,+      pointsizeDepend = False,+      integerScaling = False,+      alterAdvanceWidth = False,+      verticalFont = False,+      linguisticRenderingLayout = False,+      metamorphosisEffects = False,+      rightToLeftGlyphs = False,+      indicRearrangements = False,+      losslessFontData = False,+      convertedFont = False,+      clearTypeOptimized = False,+      lastResortFont = False,+      unitsPerEm = fromIntegral $ fontUnitsPerEm fi,+      created = fontCreated fi,+      modified = fontModified fi /// fontCreated fi,+      xMin = 0,+      yMin = 0,+      xMax = 0,+      yMax = 0,+      boldStyle = fontWeight fi > NormalWeight,+      italicStyle = fontSlant fi == Italic,+      underlineStyle = Underscore `elem` fontDecoration fi,+      outlineStyle = Outlined `elem` fontDecoration fi,+      shadowStyle = Shadow `elem` fontDecoration fi,+      condensedStyle = fontWidth fi < MediumWidth,+      extendedStyle = fontWidth fi > MediumWidth,+      lowerRecPPEM = (fromIntegral <$> fontLowestRecPPEM fi) /// 6,+      fontDirectionHint = 2,+      longLocIndices = False,+      glyphDataFormat = 0}+    hheaTbl = HheaTable {+      version = 0x00010000,+      ascent = 0,+      descent = 0,+      lineGap = 0,+      advanceWidthMax = 0,+      minLeftSideBearing = 0,+      minRightSideBearing = 0,+      xMaxExtent = 0,+      caretSlopeRise = case fontItalicAngle fi /// 0 of+          0 -> 1+          -90 -> 0+          a -> round $ cos (pi*a/180 + pi/2) * 2048,+      caretSlopeRun = case fontItalicAngle fi /// 0 of+          0 -> 0+          -90 -> 1+          a -> round $ sin (pi*a/180 + pi/2) * 2048,+      caretOffset = fontCaretOffset fi /// 0,+      numOfLongHorMetrics = 0}+    mkNameRecords _ "" = []+    mkNameRecords nid ns = +      [NameRecord MacintoshPlatform 0 0 nid $+       Strict.pack $ map (fromIntegral . (.&.0xff) . ord) ns,+       NameRecord MicrosoftPlatform 1 0x0409 nid $+       Lazy.toStrict $ runPut (traverse_ (putWord16be . fromIntegral . ord) ns)]+    (versionMajor, versionMinor) = fontVersion fi `quotRem` 1000+    fullName = fontFamily fi +++ subFamily+    subFamily = fontSubFamilyExtra fi ++++                notRegular NormalWeight (fontWeight fi) ++++                notRegular MediumWidth (fontWidth fi) ++++                notRegular NoSlant (fontSlant fi)+    wsSubFamily+      | fontWeight fi == NormalWeight && fontSlant fi == NoSlant+      = "Regular"+      | otherwise = weightName +++ notRegular NoSlant (fontSlant fi)+      where+        weightName+          | fontWeight fi < NormalWeight = "Thin"+          | fontWeight fi > NormalWeight = "Bold"+          | otherwise = ""++    nameTbl = NameTable $+        concat [+          mkNameRecords 0 $ fontCopyright fi,+          mkNameRecords 1 $ fontFamily fi +++ fontSubFamilyExtra fi ++++            notRegular MediumWidth (fontWidth fi),+          mkNameRecords 2 wsSubFamily,+          mkNameRecords 3 $ fontID fi,+          mkNameRecords 4 fullName,+          mkNameRecords 5 $ printf "Version %d.%03d" versionMajor versionMinor,+          mkNameRecords 6 $ if null (fontPsName fi)+            then take 63 $ map (\c -> if c == ' ' then '-' else c) fullName+            else fontPsName fi,+          mkNameRecords 7 $ fontTrademark fi,+          mkNameRecords 8 $ fontManufacturer fi,+          mkNameRecords 9 $ fontDesigner fi,+          mkNameRecords 10 $ fontDescription fi,+          mkNameRecords 11 $ fontVendorUrl fi,+          mkNameRecords 12 $ fontDesignerUrl fi,+          mkNameRecords 13 $ fontLicence fi,+          mkNameRecords 14 $ fontLicenceUrl fi,+          mkNameRecords 16 $ fontFamily fi,+          mkNameRecords 17 subFamily,+          mkNameRecords 19 $ fontSampleText fi,+          mkNameRecords 21 $+            if null (fontSubFamilyExtra fi) then ""+            else fontFamily fi +++ fontSubFamilyExtra fi,+          mkNameRecords 22 $+            if null (fontSubFamilyExtra fi) then ""+            else notRegular NormalWeight (fontWeight fi) ++++                 notRegular MediumWidth (fontWidth fi) ++++                 notRegular NoSlant (fontSlant fi),+          mkNameRecords 23 $ fontLightPalette fi,+          mkNameRecords 24 $ fontDarkPalette fi]+    postTbl = PostTable {+      postVersion = PostTable2,+      italicAngle = round $ (fontItalicAngle fi /// 0)+                    * 0x00010000,+      underlinePosition = fontUnderlinePosition fi ///+                          (- fromIntegral (fontUnitsPerEm fi `quot` 8)),+      underlineThickness = fontUnderlineThickness fi ///+                           fromIntegral (fontUnitsPerEm fi `quot` 10),+      isFixedPitch = fromIntegral $ fromEnum $+                     fontMonospaced fi /// False,+      minMemType42 = 0,+      maxMemType42 = 0,+      minMemType1 = 0,+      maxMemType1 = 0,+      glyphNameIndex = [],+      postStrings = []}+    (panose1, panose2, panose3, panose4, panose5,+     panose6, panose7, panose8, panose9, panose10) =+      fontPanose fi /// (0, 0, 0, 0, 0, 0, 0, 0, 0, 0)+    vendorID = case fontVendorID fi of+      Nothing -> 0x20202020+      Just (a, b, c, d) -> fromIntegral $+        ord a `shift` 24 .|. ord b `shift` 16 .|.+        ord c `shift` 8  .|. ord d+    selectionFlags = makeFlag+      [fontSlant fi == Italic,+       Underscore `elem` fontDecoration fi,+       Negative `elem` fontDecoration fi,+       Outlined `elem` fontDecoration fi,+       StrikeOut `elem` fontDecoration fi,+       fontWeight fi > NormalWeight,+       fontWeight fi == NormalWeight &&+       fontWidth fi == MediumWidth &&+       fontSlant fi == NoSlant &&+       null (fontSubFamilyExtra fi),+       True,+       null (fontSubFamilyExtra fi),+       fontSlant fi == Oblique]+    os2Tbl = OS2Table {+      os2version = 5,+      xAvgCharWidth = 0,+      usWeightClass = weightClass $ fontWeight fi,+      usWidthClass = widthClass $ fontWidth fi,+      fsType = embeddedBits $ fontEmbeddingLicence fi,+      ySubscriptXSize = (fst <$> fontSubScriptSize fi) ///+                        (fontUnitsPerEm fi `quot` 2),+      ySubscriptYSize = (snd <$> fontSubScriptSize fi) ///+                        (fontUnitsPerEm fi `quot` 2),+      ySubscriptXOffset = (fst <$> fontSubScriptOffset fi) /// 0,+      ySubscriptYOffset = (snd <$> fontSubScriptOffset fi) ///+                          (- (fontUnitsPerEm fi `quot` 4)),+      ySuperscriptXSize = (fst <$> fontSuperScriptSize fi) ///+                          (fontUnitsPerEm fi `quot` 2),+      ySuperscriptYSize = (snd <$> fontSuperScriptSize fi) ///+                          (fontUnitsPerEm fi `quot` 2),+      ySuperscriptXOffset = (fst <$> fontSuperScriptOffset fi) ///+                            round (realToFrac (ySubscriptYOffset os2Tbl) *+                                   cos (pi/180*((fontItalicAngle fi /// 0) + pi/2))),+      ySuperscriptYOffset = (snd <$> fontSuperScriptOffset fi) ///+                            ((fontUnitsPerEm fi - fontEmBase fi) `quot` 2),+      yStrikeoutSize = fontStrikoutSize fi ///+                       fromIntegral (fontUnitsPerEm fi `quot` 20),+      yStrikeoutPosition = fontStrikeoutPosition fi ///+                           fromIntegral (fontUnitsPerEm fi*10 `quot` 55),+      bFamilyClass = fromIntegral $+                     ((\(x,y) -> (x `shift` 8 .|. y)) <$> fontFamilyClass fi)+                     /// 0,+      bFamilyType = fromIntegral panose1,+      bSerifStyle = fromIntegral panose2,+      bWeight = fromIntegral panose3,+      bProportion = fromIntegral panose4, +      bContrast = fromIntegral panose5,+      bStrokeVariation = fromIntegral panose6,+      bArmStyle = fromIntegral panose7,+      bLetterform = fromIntegral panose8,+      bMidline = fromIntegral panose9,+      bXHeight = fromIntegral panose10,+      ulUnicodeRange1 = (view _1 <$> fontUnicodeRanges fi) /// 3,+      ulUnicodeRange2 = (view _2 <$> fontUnicodeRanges fi) /// 0,+      ulUnicodeRange3 = (view _3 <$> fontUnicodeRanges fi) /// 0,+      ulUnicodeRange4 = (view _4 <$> fontUnicodeRanges fi) /// 0,+      achVendID = vendorID,+      fsSelection = selectionFlags,+      usFirstCharIndex = 0,+      usLastCharIndex = 0,+      sTypoAscender = fontUnitsPerEm fi - fontEmBase fi,+      sTypoDescender = fromIntegral $ - fontEmBase fi,+      sTypoLineGap = fontLineGap fi,+      usWinAscent = 0,+      usWinDescent = 0,+      ulCodePageRange1 = (fst <$> fontCodepageRanges fi) /// 1,+      ulCodePageRange2 = (snd <$> fontCodepageRanges fi) /// 0,+      sxHeight = 0,+      sCapHeight = fontCapHeight fi /// 0,+      usDefaultChar = 0,+      usBreakChar = 0,+      usMaxContext = 1,+      usLowerOpticalPointSize = fromIntegral $+        fontLowerOpticalPointSize fi /// 0,+      usUpperOpticalPointSize = fromIntegral $+        fontUpperOpticalPointSize fi /// 0xffff}

@@ -1,23 +1,25 @@-{-# LANGUAGE MultiWayIf, TupleSections #-}+{-# LANGUAGE MultiWayIf, TupleSections, DeriveTraversable #-} module Opentype.Fileformat.Glyph where import Opentype.Fileformat.Types import Opentype.Fileformat.Maxp import Opentype.Fileformat.Hhea import Opentype.Fileformat.Head import qualified Data.Vector as V-import Data.Foldable (traverse_, for_)+import Data.Foldable (traverse_, for_, foldlM) import Control.Monad+import Control.Monad.Cont+import Data.List (foldl')+import Data.Maybe (isJust, fromMaybe) import Data.Function (fix) import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString as Strict import Data.Word import Data.Int-import Data.Maybe (isJust) import Data.Bits import Data.Binary import Data.Binary.Put import Data.Binary.Get-+import Lens.Micro  -- | This table contains the data that defines the appearance of -- the glyphs in the font. This includes specification of the points@@ -25,24 +27,57 @@ -- instructions that grid-fit that glyph. The glyf table supports the -- definition of simple glyphs and compound glyphs, that is, glyphs -- that are made up of other glyphs.-data GlyfTable = GlyfTable (V.Vector Glyph)+newtype GlyfTable = GlyfTable {glyphVector :: (V.Vector (Glyph Int))}   deriving Show -data Glyph = Glyph {+type StandardGlyph = Glyph Int++emptyGlyfTable :: GlyfTable+emptyGlyfTable = GlyfTable V.empty++-- | The glyph type is parametrized over the type of glyph reference for compound glyphs.+data Glyph a = Glyph {+  -- | The name of the glyph.  This field isn't used when writing+  -- truetype files.+  glyphName :: String,   advanceWidth :: Word16,   leftSideBearing :: Int16,+  -- | Bounding box: /will be overwritten/   glyphXmin :: FWord,+  -- | Bounding box: /will be overwritten/   glyphYmin :: FWord,+  -- | Bounding box: /will be overwritten/   glyphXmax :: FWord,+  -- | Bounding box: /will be overwritten/   glyphYmax :: FWord,-  glyphOutlines :: GlyphOutlines}-  deriving Show+  glyphOutlines :: GlyphOutlines a}+  deriving (Show, Functor, Foldable, Traversable) -data GlyphOutlines =+data GlyphOutlines a =   GlyphContours [[CurvePoint]] Instructions |-  CompositeGlyph [GlyphComponent]-  deriving Show+  CompositeGlyph [GlyphComponent a]+  deriving (Show, Functor, Foldable, Traversable) +-- | traversal over simple glyph contours+_glyphContours :: Traversal' StandardGlyph [[CurvePoint]]+_glyphContours f glyph = case glyphOutlines glyph of+  GlyphContours pts instrs -> (\pts2 -> glyph {glyphOutlines = GlyphContours pts2 instrs})+                              <$> f pts+  _ -> pure glyph++-- | instructions for simple glyphs+_glyphInstructions :: Traversal' StandardGlyph Instructions+_glyphInstructions f glyph = case glyphOutlines glyph of+  GlyphContours pts instrs -> (\instrs2 -> glyph {glyphOutlines = GlyphContours pts instrs2})+                              <$> f instrs+  _ -> pure glyph++-- | traversal over compound glyph components+_glyphComponents :: Traversal' StandardGlyph [GlyphComponent Int]+_glyphComponents f glyph = case glyphOutlines glyph of+  CompositeGlyph comps -> (\c -> glyph {glyphOutlines = CompositeGlyph c}) <$> f comps+  _ -> pure glyph+ -- | @CurvePoint x y onCurve@: Points used to describe the outline -- using lines and quadratic beziers.  Coordinates are absolute (not -- relative).  If two off-curve points follow each other, an on-curve@@ -53,9 +88,9 @@ -- | TODO: make a proper datatype for instructions. type Instructions = V.Vector Word8 -data GlyphComponent =+data GlyphComponent a =   GlyphComponent {-  componentID :: Int,+  componentID :: a,   componentInstructions :: Maybe Instructions,   -- | transformation matrix for scaling the glyph   componentXX :: ShortFrac,@@ -75,7 +110,7 @@   -- offset is unscaled (microsoft and opentype default) in the   -- rasterizer.   componentY :: Int,-    -- | see previous+  -- | see previous   matchPoints :: Bool,   -- | For the xy values if `matchPoints` is `False`.   roundXYtoGrid :: Bool,@@ -87,16 +122,20 @@   -- affect behaviors in some platforms, however. (See Apple’s   -- specification for details regarding behavior in Apple platforms.)   overlapCompound :: Bool,-  -- | The component offset is scaled by the rasterizer (apple).  Should be-  -- set to `False` (opentype default), unless the font is meant to work-  -- with old apple software.-  scaledComponentOffset :: Bool+  -- | If Just True, The component offset should be scaled by the+  -- rasterizer.  If the value is set to Nothing, it is platform+  -- dependent (False for opentype).  Set this value to "Just False"+  -- for new fonts.+  scaledComponentOffset :: Maybe Bool   }-  deriving Show+  deriving (Show, Functor, Foldable, Traversable) -emptyGlyph :: Glyph-emptyGlyph = Glyph 0 0 0 0 0 0 (GlyphContours [] V.empty)+sum' :: Num a => [a] -> a+sum' = foldl' (+) 0 +emptyGlyph :: StandardGlyph+emptyGlyph = Glyph ".notdef" 0 0 0 0 0 0 (GlyphContours [] V.empty)+ readHmetrics :: Int -> Int -> Get [(Word16, Int16)] readHmetrics 1 m = do   aw <- getWord16be@@ -116,7 +155,7 @@   else (*2).fromIntegral <$> getWord16be   readGlyphTable :: [(Int, Int)] -> [(Word16, Int16)] -> Strict.ByteString-               -> Either String (V.Vector Glyph)+               -> Either String (V.Vector StandardGlyph) readGlyphTable glyphSizes hmetrics glyfBs =   V.fromList <$> zipWithM readGlyph glyphSizes hmetrics   where@@ -129,10 +168,10 @@           Right (_, _, g) -> Right $ g {advanceWidth = aw, leftSideBearing = lsb}  -- return bytestring lengths-writeGlyphs :: V.Vector Glyph -> PutM (V.Vector Int)-writeGlyphs = traverse writeGlyph+writeGlyphs :: Bool -> V.Vector StandardGlyph -> PutM (V.Vector Int)+writeGlyphs scale vec = traverse (writeGlyph . updateBB scale vec) vec -writeGlyph :: Glyph -> PutM Int+writeGlyph :: StandardGlyph -> PutM Int writeGlyph g = do   putLazyByteString bs   replicateM_ pad (putWord8 0)@@ -153,7 +192,7 @@   where     offsets = V.scanl (+) 0 vec     -writeHmtx :: V.Vector Glyph -> PutM Int+writeHmtx :: V.Vector StandardGlyph -> PutM Int writeHmtx gs   | V.null gs = return 0   | otherwise = @@ -173,8 +212,8 @@       tl = findTail (len-2) 0       (dbl, sngl) = V.splitAt (len-tl) gs   -putGlyph :: Glyph -> Put-putGlyph (Glyph _ _ xmin ymin xmax ymax outlines) = do+putGlyph :: StandardGlyph -> Put+putGlyph (Glyph _ _ _ xmin ymin xmax ymax outlines) = do   putInt16be $ case outlines of     GlyphContours pts _ -> fromIntegral $ length pts     _ -> -1@@ -189,7 +228,7 @@       traverse_ (putComponent True) (init comps)       putComponent False $ last comps -getGlyph :: Get Glyph+getGlyph :: Get StandardGlyph getGlyph = do   n <- getInt16be   xmin <- getInt16be@@ -203,7 +242,7 @@       (c, more) <- getComponent       if more then (c:) <$> nextComponent         else return [c]-  return $ Glyph 0 0 xmin ymin xmax ymax outlines+  return $ Glyph "" 0 0 xmin ymin xmax ymax outlines  isShort :: FWord -> Bool isShort n = abs n <= 255@@ -261,7 +300,7 @@     allPts = case concat points of       [] -> []       pts@(p: pts2) -> p: zipWith subCoord pts2 pts-    subCoord (CurvePoint x1 y1 _) (CurvePoint x2 y2 on) =+    subCoord (CurvePoint x2 y2 on) (CurvePoint x1 y1 _) =       CurvePoint (x2-x1) (y2-y1) on     flags = case allPts of       [] -> []@@ -312,10 +351,9 @@     (c, r) = splitAt n l  toOffsets :: (Num a) => [a] -> [a]-toOffsets [] = []-toOffsets (x:xs) = scanl (-) x xs+toOffsets = tail . scanl (+) 0    -getContour :: Int -> Get GlyphOutlines+getContour :: Int -> Get (GlyphOutlines Int) getContour 0 =  return $ GlyphContours [] V.empty getContour nContours = do   lastPts <- replicateM nContours (fromIntegral <$> getWord16be)@@ -332,14 +370,113 @@ isShortInt :: Int -> Bool isShortInt x = x <= 127 && x >= -128 -glyphExtent, glyphRsb :: Glyph -> Int16+glyphExtent, glyphRsb :: StandardGlyph -> Int16 glyphRsb g =   fromIntegral (advanceWidth g) - glyphExtent g    glyphExtent glyf = leftSideBearing glyf + (glyphXmax glyf - glyphXmin glyf) -updateHhea :: V.Vector Glyph -> HheaTable -> HheaTable-updateHhea v h = V.foldl updateHhea1+extendBB :: (FWord, FWord, FWord, FWord)+         -> (FWord, FWord, FWord, FWord)+         -> (FWord, FWord, FWord, FWord) +extendBB (xMin1, yMin1, xMax1, yMax1)+  (xMin2, yMin2, xMax2, yMax2) =+  (min xMin1 xMin2, min yMin1 yMin2,+   max xMax1 xMax2, max yMax1 yMax2)++extendBB2 :: (FWord, FWord, FWord, FWord) -> CurvePoint+          -> (FWord, FWord, FWord, FWord) +extendBB2 (xMin1, yMin1, xMax1, yMax1) (CurvePoint x y _) =+  (min xMin1 x, min yMin1 y, max xMax1 x, max yMax1 y)++minBB :: (FWord, FWord, FWord, FWord)+minBB = (maxBound, maxBound, minBound, minBound)++safeIndex :: Int -> [a] -> Maybe a+safeIndex _ [] = Nothing+safeIndex 0 (x:_) = Just x+safeIndex n (_:l) = safeIndex (n-1) l++onCurve :: CurvePoint -> Bool+onCurve (CurvePoint _ _ on) = on++-- get scaled on-curve points+getScaledContours' :: Int -> Bool -> V.Vector StandardGlyph -> StandardGlyph -> [[CurvePoint]]+getScaledContours' d scale vec glyph+  | d <= 0 = []+  | otherwise =+    case glyphOutlines glyph of+      GlyphContours cp _ -> cp+      CompositeGlyph comps ->+        flip runCont id $ foldlM scalePoints [] comps+    where+      getCompContours :: GlyphComponent Int -> [[CurvePoint]]+      getCompContours comp =+        case vec V.!? componentID comp of+          Nothing -> []+          Just g2 -> getScaledContours' (d-1) scale vec g2+      scalePoints :: [[CurvePoint]] -> GlyphComponent Int -> Cont [[CurvePoint]] [[CurvePoint]]+      scalePoints pts comp+        | matchPoints comp = cont $ \next -> +            let pts2 = getCompContours comp+                (tx, ty) = fromMaybe (0, 0) $ do+                  CurvePoint x1 y1 _ <- safeIndex (componentX comp) $ concat pts+                  CurvePoint x2 y2 _ <- safeIndex (componentY comp) $ concat pts2+                  return (realToFrac $ x1-x2, realToFrac $ y1-y2)+            in if useMyMetrics comp+               then map (map (scalePt tx ty)) pts2+               else next $ pts ++ map (map (scalePt tx ty)) pts2+        | otherwise =  cont $ \next -> +            if useMyMetrics comp+            then map (map (scalePt offsetX offsetY)) (getCompContours comp)+            else next $ pts ++ map (map (scalePt offsetX offsetY)) (getCompContours comp)+            where+              sqr x = x*x+              (offsetX, offsetY) =+                if fromMaybe scale (scaledComponentOffset comp)+                then (realToFrac (componentX comp) *+                      sqrt (sqr (realToFrac (componentXX comp)) ++                            sqr (realToFrac (componentYX comp))),+                      realToFrac (componentY comp) *+                      sqrt (sqr (realToFrac (componentXY comp)) ++                            sqr (realToFrac (componentYY comp))))+                else (realToFrac (componentX comp), realToFrac (componentY comp))+              xx, xy, yx, yy :: Double+              (xx, xy, yx, yy) =+                (realToFrac (componentXX comp),+                 realToFrac (componentXY comp),+                 realToFrac (componentYX comp),+                 realToFrac (componentYY comp))+              scalePt tx ty (CurvePoint x y on) =+                if roundXYtoGrid comp then+                  CurvePoint+                  (round tx + round (realToFrac x * xx + realToFrac y * xy))+                  (round ty + round (realToFrac x * yx + realToFrac y * yy))+                  on+                else+                  CurvePoint+                  (round $ realToFrac x * xx + realToFrac y * xy + tx)+                  (round $ realToFrac x * yx + realToFrac y * yy + ty)+                  on++glyphBB :: Bool -> V.Vector StandardGlyph -> StandardGlyph -> (FWord, FWord, FWord, FWord)+glyphBB scale vec glyph =+  foldl' extendBB2 minBB $+  filter onCurve $ concat $+  getScaledContours' 10 scale vec glyph++updateBB :: Bool -> V.Vector StandardGlyph -> StandardGlyph -> StandardGlyph+updateBB scale vec glyph =+  glyph {glyphXmin = xMin_,+         glyphYmin = yMin_,+         glyphXmax = xMax_,+         glyphYmax = yMax_}+  where+    (xMin_, yMin_, xMax_, yMax_) = glyphBB scale vec glyph+++updateHhea :: V.Vector StandardGlyph -> HheaTable -> HheaTable+updateHhea v h = V.foldl' updateHhea1                  (h {advanceWidthMax     = minBound,                      minLeftSideBearing  = maxBound,                      minRightSideBearing = maxBound,@@ -347,22 +484,21 @@                  v    -updateMinMax :: (FWord, FWord, FWord, FWord)-             -> Glyph -> (FWord, FWord, FWord, FWord)-updateMinMax (xmin, ymin, xmax, ymax) g =+updateMinMax  :: (FWord, FWord, FWord, FWord, Double)+              -> StandardGlyph -> (FWord, FWord, FWord, FWord, Double)+updateMinMax (xmin, ymin, xmax, ymax, totWidth) g =   (min xmin (glyphXmin g),    min ymin (glyphYmin g),    max xmax (glyphXmax g),-   max ymax (glyphYmax g))--updateHead :: V.Vector Glyph -> HeadTable -> HeadTable-updateHead vec headTbl =-  headTbl {xMin = xmin, yMin = ymin,-           xMax = xmax, yMax = ymax}-  where (xmin, ymin, xmax, ymax) =-          V.foldl updateMinMax (maxBound, maxBound, minBound, minBound) vec+   max ymax (glyphYmax g),+   totWidth + realToFrac (glyphXmax g - glyphXmin g)) -updateHhea1 :: HheaTable -> Glyph -> HheaTable+getMinMax :: V.Vector StandardGlyph -> (FWord, FWord, FWord, FWord, FWord)+getMinMax vec =+  over _5 (round . (/ realToFrac (V.length vec))) $+  V.foldl' updateMinMax (maxBound, maxBound, minBound, minBound, 0) vec+  +updateHhea1 :: HheaTable -> StandardGlyph -> HheaTable updateHhea1 hhea g =   hhea {advanceWidthMax     = max (advanceWidthMax hhea)                               (advanceWidth g),@@ -372,8 +508,8 @@                               (glyphRsb g),         xMaxExtent          = max (xMaxExtent hhea)                               (glyphExtent g)}-updateMaxp :: V.Vector Glyph -> MaxpTable -> MaxpTable-updateMaxp vec tbl = V.foldl (updateMaxp1 vec)+updateMaxp :: V.Vector StandardGlyph -> MaxpTable -> MaxpTable+updateMaxp vec tbl = V.foldl' (updateMaxp1 vec)                      (tbl {numGlyphs = 0,                            maxPoints = 0,                            maxContours = 0,@@ -383,7 +519,7 @@                            maxComponentDepth = 0})                      vec -updateMaxp1 :: V.Vector Glyph -> MaxpTable -> Glyph -> MaxpTable+updateMaxp1 :: V.Vector StandardGlyph -> MaxpTable -> StandardGlyph -> MaxpTable updateMaxp1 vec maxp glyf =   maxp {numGlyphs            = numGlyphs maxp + 1,         maxPoints            = max (maxPoints maxp) $@@ -400,7 +536,7 @@                                componentDepth vec glyf}  overComponents :: ([[CurvePoint]] -> Word16) -> ([Word16] ->  Word16)-               -> Int -> Bool -> V.Vector Glyph -> Glyph -> Word16+               -> Int -> Bool -> V.Vector StandardGlyph -> StandardGlyph -> Word16 overComponents f h maxD d v g   | maxD <= 0 = 0   | otherwise =@@ -414,10 +550,10 @@                 Nothing -> 0                 Just g2 -> overComponents f h (maxD-1) False v g2    -glyfPoints, glyfContours, componentRefs, componentDepth, componentPoints, componentContours :: V.Vector Glyph -> Glyph -> Word16+glyfPoints, glyfContours, componentRefs, componentDepth, componentPoints, componentContours :: V.Vector StandardGlyph -> StandardGlyph -> Word16  glyfPoints  =-  overComponents (sum . map (fromIntegral.length)) (const 0) 2 False+  overComponents (sum' . map (fromIntegral.length)) (const 0) 2 False  glyfContours =   overComponents (fromIntegral.length) (const 0) 2 False@@ -426,15 +562,15 @@   overComponents (const 0) (fromIntegral.length) 2 True  componentPoints =-  overComponents (sum . map (fromIntegral . length)) sum 10 True+  overComponents (sum' . map (fromIntegral . length)) sum' 10 True  componentDepth =   overComponents (const 0) ((+1).maximum) 10 True  componentContours =-  overComponents (fromIntegral.length) sum 10 True+  overComponents (fromIntegral.length) sum' 10 True -putComponent :: Bool -> GlyphComponent -> Put+putComponent :: Bool -> GlyphComponent Int -> Put putComponent more c = do   putWord16be flag   putWord16be $ fromIntegral $ componentID c@@ -466,8 +602,8 @@           if matchPoints c           then componentX c > 0xff ||                componentY c > 0xff-          else (not $ isShortInt $ componentX c) ||-               (not $ isShortInt $ componentY c),+          else not (isShortInt $ componentX c) ||+               not (isShortInt $ componentY c),           not $ matchPoints c,           roundXYtoGrid c,           componentXX c /= 1 &&@@ -481,10 +617,10 @@           isJust (componentInstructions c),           useMyMetrics c,           overlapCompound c,-          scaledComponentOffset c,-          not $ scaledComponentOffset c]+          fromMaybe False (scaledComponentOffset c),+          not $ fromMaybe True (scaledComponentOffset c)] -getComponent :: Get (GlyphComponent, Bool)+getComponent :: Get (GlyphComponent Int, Bool) getComponent = do   flag <- getWord16be   gID <- getWord16be@@ -529,6 +665,9 @@   return (     GlyphComponent (fromIntegral gID) instructions tXX tXY tYX tYY       cX cY (not $ byteAt flag 1) (byteAt flag 2)-      (byteAt flag 9) (byteAt flag 10) (byteAt flag 11),+      (byteAt flag 9) (byteAt flag 10)+      (if | (byteAt flag 11) -> Just True+          | (byteAt flag 12) -> Just False+          | otherwise -> Nothing),     byteAt flag 5) -- more components 

@@ -15,7 +15,7 @@ -- most likely to be written and other information about the placement -- of glyphs in the em square. data HeadTable = HeadTable {-  -- | 0x00010000 for version 1.0.  /Will be auto written./+  -- | 0x00010000 for version 1.0.  /Will be overwritten./   headVersion :: Fixed,   -- | set by font manufacturer.   fontRevision :: Fixed,@@ -77,13 +77,13 @@   -- bit 15 zero   unitsPerEm :: Word16,   created :: UTCTime,  modified :: UTCTime,-  -- | /Will be auto written./+  -- | /Will be overwritten./   xMin :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   yMin :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   xMax :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   yMax :: FWord,   -- macStyle   @@ -98,9 +98,9 @@   lowerRecPPEM :: Word16,   -- | deprecated, will be set to 2   fontDirectionHint :: Int16,-  -- | 0 for short offsets, 1 for long.  /Will be auto written./+  -- | 0 for short offsets, 1 for long.  /Will be overwritten./   longLocIndices :: Bool,-  -- | 0 for current format.  /Will be auto written./+  -- | 0 for current format.  /Will be overwritten./   glyphDataFormat :: Int16   }   deriving Show

@@ -9,21 +9,21 @@  -- | This table contains information for horizontal layout.  data HheaTable = HheaTable {-  -- | 0x00010000 (1.0), will be auto written.+  -- | 0x00010000 (1.0), will be overwritten.   version :: Fixed,-  -- | Distance from baseline of highest ascender+  -- | Distance from baseline of highest ascender.  /Will be overwritten./   ascent :: FWord,-  -- | Distance from baseline of lowest descender+  -- | Distance from baseline of lowest descender.  /Will be overwritten./   descent :: FWord,-  -- | typographic line gap+  -- | typographic line gap.  Will be overwritten when OS/2 table is present.   lineGap :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   advanceWidthMax :: UFWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   minLeftSideBearing :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   minRightSideBearing :: FWord,-  -- | /Will be auto written./+  -- | /Will be overwritten./   xMaxExtent :: FWord,   -- | used to calculate the slope of the caret (rise/run) set to 1 for vertical caret   caretSlopeRise :: Int16,@@ -31,7 +31,7 @@   caretSlopeRun :: Int16,   -- | set value to 0 for non-slanted fonts   caretOffset :: FWord,-  -- | number of advance widths in metrics table. /Will be auto written./+  -- | number of advance widths in metrics table. /Will be overwritten./   numOfLongHorMetrics :: Word16}   deriving Show 

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} module Opentype.Fileformat.Kern where import Opentype.Fileformat.Types@@ -7,6 +8,7 @@ import Data.Bits import Control.Monad import Data.Foldable+import Lens.Micro.TH  -- | @KernPair left right adjustment@: Pair of kerning values.  left -- and right are indices in the glyph table.@@ -14,11 +16,13 @@   deriving Show  data KernTable = KernTable {-  -- | various flags+  -- | various flags, will be overwritten with 1 (default)   coverage :: Word8,   kernPairs :: [KernPair]}   deriving Show +makeLensesFor [("kernPairs", "_kernPairs")] ''KernTable+ getKernTable :: Get KernTable getKernTable = do   version <- getWord16be@@ -40,12 +44,12 @@         KernPair <$> getWord16be <*>  getWord16be <*> getInt16be  putKernTable :: KernTable -> Put-putKernTable (KernTable cov pairs) = do+putKernTable (KernTable _ pairs) = do   putWord16be 0   putWord16be 1   putWord16be 0   putWord16be $ fromIntegral $ 14+6 * length pairs-  putWord16be $ fromIntegral cov+  putWord16be $ fromIntegral 1   putWord16be $ fromIntegral len   putWord16be searchRange   putWord16be entrySelector

@@ -43,6 +43,9 @@   maxComponentDepth :: Word16}   deriving Show +emptyMaxpTable :: MaxpTable+emptyMaxpTable = MaxpTable 0x00010000 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + putMaxpTable :: MaxpTable -> Put putMaxpTable maxp = do   putWord32be $ maxpVersion maxp

@@ -1,12 +1,15 @@ module Opentype.Fileformat.Name where import Opentype.Fileformat.Types-import Data.List (sort)+import Data.List (sort, foldl')+import Data.Maybe (fromMaybe) import Data.Word import Control.Monad import Data.Binary.Put+import Data.Tuple (swap) import Data.Foldable (for_, traverse_) import Data.Traversable (for)+import qualified Data.HashMap.Strict as HM import qualified Data.ByteString as Strict  -- | This table allows multilingual strings to be associated with the@@ -33,7 +36,7 @@ -- encodingID.  This library doesn't do any conversion.  For more -- information see the opentype specification: -- https://www.microsoft.com/typography/otspec/name.htm-data NameTable = NameTable [NameRecord]+data NameTable = NameTable {nameRecords :: [NameRecord]}   deriving Show  data NameRecord = NameRecord {@@ -59,18 +62,25 @@   putWord16be 0   putWord16be $ fromIntegral len   putWord16be $ fromIntegral $ len * 12 + 6-  for_ (zip offsets records) $ \(offset, r) -> do+  for_ records $ \r -> do     putPf $ namePlatform r     putWord16be $ nameEncoding r     putWord16be $ nameLanguage r     putWord16be $ nameID r     putWord16be $ fromIntegral $ Strict.length $ nameString r-    putWord16be offset-  traverse_ (putByteString.nameString) records+    putWord16be $ fromMaybe 0 $ fromIntegral <$>+      HM.lookup (nameString r) offsets+  traverse_ putByteString $ reverse noDups   where len = length records         records = sort records_-        lengths = map (fromIntegral . Strict.length . nameString) records-        offsets = scanl (+) 0 lengths+        (noDups, offsets) = snd $ foldl'+          (\(offset, (noDups, mp)) r ->+             if HM.member (nameString r) mp+             then (offset, (noDups, mp))+             else (Strict.length (nameString r) + offset, +                    (nameString r:noDups, HM.insert (nameString r) offset mp)))+          (0, ([], HM.empty)) records+          readNameTable :: Strict.ByteString -> Either String NameTable readNameTable bs = do

@@ -35,8 +35,6 @@   -- vertical. Zero for upright text, negative for text that leans to   -- the right (forward).   italicAngle :: Fixed,-  -- | suggested values for the underline thickness.-  underlinePosition :: FWord,   -- | This is the suggested distance of the top of the underline from   -- the baseline (negative values indicate below baseline).   --@@ -45,6 +43,8 @@   -- historical reasons. The value of the PostScript key may be   -- calculated by subtracting half the underlineThickness from the   -- value of this field.+  underlinePosition :: FWord,+  -- | suggested values for the underline thickness.   underlineThickness :: FWord,   -- | Set to 0 if the font is proportionally spaced, non-zero if the   -- font is not proportionally spaced (i.e. monospaced).

@@ -0,0 +1,111 @@+-- | Utilities for making it easier to create Tables from Unicode+-- data.+module Opentype.Fileformat.Unicode+  (-- * Unicode tables+    UnicodeGlyphMap, UnicodeKernPairs, makeUnicodeTables,+    -- * Postscript Names+    module Opentype.Fileformat.Unicode.PostNames,+  )++where+import Opentype.Fileformat.Unicode.PostNames+import Opentype.Fileformat+import Opentype.Fileformat.FontInfo+import Data.Maybe (fromMaybe, isNothing, mapMaybe)+import qualified Data.Vector as V+import qualified Data.Map as M+import Data.IntSet as IS (empty)+import Data.List (sortBy)+import Data.Either+import Control.Applicative ((<|>))+import qualified Data.HashMap.Strict as HM+import Data.Function++-- | A map from glyphnames to glyphs.  Unicode points are derived+-- using `nameToCodepoint`.  Names without matching codepoint can only+-- be used in composite glyphs.  If the `glyphName` has no matching+-- key in the map, it will be substituted by the empty glyph+type UnicodeGlyphMap = HM.HashMap String (Glyph String)+type UnicodeKernPairs = [(String, String, FWord)]++-- | Create an opentype font from a `UnicodeGlyphMap` and `FontInfo`+-- structure.+makeUnicodeFont :: UnicodeGlyphMap -> UnicodeKernPairs -> FontInfo -> OpentypeFont+makeUnicodeFont uniGlyphs kernPrs info =+  OpentypeFont False headTbl hheaTbl cmapTbl+  nameTbl postTbl (Just os2Tbl) (if null (kernPairs kernTbl) then Nothing else Just kernTbl)+  (QuadTables emptyMaxpTable glyfTbl) M.empty+  where+    (headTbl, hheaTbl, nameTbl, postTbl', os2Tbl) =+      infoToTables info+    (cmapTbl, glyfTbl, postTbl, kernTbl) =+      makeUnicodeTables uniGlyphs kernPrs postTbl'+  ++-- | Given a `UnicodeGlyphMap`, create a `CmapTable`, `GlyfTable` and+-- `KernTable` and update the `PostTable`.+makeUnicodeTables :: UnicodeGlyphMap -> UnicodeKernPairs -> PostTable -> (CmapTable, GlyfTable, PostTable, KernTable)+makeUnicodeTables uniGlyphs kernPrs postTbl =+  (cmapTbl, GlyfTable glyphVector,+   postTbl {postVersion = PostTable2,+            glyphNameIndex = postscriptNameIndex,+            postStrings = postscriptExtraNames},+   KernTable 1 realKernPairs)+  where+    uniqueCodepoints, codepoints :: [(String, (Int, Glyph String))]+    glyphComps :: [(String, Glyph String)]+    uniqueCodepoints =+      filter (\(s, (_, g)) -> glyphName g == s)+      codepoints+    (codepoints, glyphComps) =+      partitionEithers $ map getCodePoint $+      HM.toList uniGlyphs+    nameMap :: HM.HashMap String GlyphID+    nameMap =+      HM.fromList $ flip zip [1..] $+      map fst (sortBy (compare `on` (fst.snd)) uniqueCodepoints)+      ++ map fst glyphComps+    postscriptNameMap :: HM.HashMap String Int+    postscriptNameMap =+      HM.fromList $ zip postscriptExtraNames [258..]+    postscriptExtraNames :: [String]+    postscriptExtraNames =+      filter (isNothing . postscriptIndex) $+      map fst uniqueCodepoints+    postscriptNameIndex :: [Int]+    postscriptNameIndex =+      flip map uniqueCodepoints $ \(n, _) ->+      fromMaybe 0 $+      HM.lookup n postscriptNameMap+      <|> postscriptIndex n+    glyphVector :: V.Vector StandardGlyph+    glyphVector =+      V.fromList $+      map (normalizeGlyph.snd.snd) uniqueCodepoints +++      map (normalizeGlyph.snd) glyphComps+    codepointMap :: WordMap GlyphID+    codepointMap =+      M.fromList $+      flip map codepoints $ \(_, (code, g)) ->+      (fromIntegral code,+       fromMaybe 0 $ HM.lookup (glyphName g) nameMap)+    normalizeGlyph :: Glyph String -> StandardGlyph+    normalizeGlyph =+      fmap (fromIntegral . fromMaybe 0 . (`HM.lookup` nameMap))+    getCodePoint (name, g) =+      case nameToCodepoint name of+        Nothing -> Right (name, g)+        Just cp -> Left (name, (cp, g))+    cmapTbl = CmapTable $ bmpCmap : fullCmap+    bmpCmap = CMap MicrosoftPlatform 1 0 MapFormat4 IS.empty codepointMap+    fullCmap+      | M.null codepointMap ||+        fst (M.findMax codepointMap) <= 0xffff = []+      | otherwise =+        [CMap MicrosoftPlatform 10 0+         MapFormat12 IS.empty codepointMap]+    realKernPairs = flip mapMaybe kernPrs $ \(s1, s2, x) -> do+      c1 <- HM.lookup s1 nameMap+      c2 <- HM.lookup s2 nameMap+      return $ KernPair c1 c2 x+    

@@ -0,0 +1,919 @@+module Opentype.Fileformat.Unicode.PostNames+  (CodePoint, codepointName, hasDescriptiveName, nameToCodepoint,+   postscriptIndex, postscriptName, postscriptNames)+where+import qualified Data.Map.Strict as M+import qualified Data.HashMap.Strict as HM+import Text.Printf+import qualified Data.Set as S+import Opentype.Fileformat+import Data.Tuple (swap)+import Data.Word+import qualified Data.Vector as V+import Data.Char+import Data.Maybe (fromMaybe)+import Data.List (isPrefixOf)++type CodePoint = Int++-- | Standard name for this codepoint.  Will be a descriptive name if+-- one is available, otherwise uni<hex-codepoint>.+codepointName :: CodePoint -> String+codepointName cp =+  case M.lookup cp codeMap of+    Just n -> n+    Nothing+      | cp > 0xffff -> printf "u%06x" cp+      | otherwise -> printf "uni%04x" cp++hasDescriptiveName :: CodePoint -> Bool+hasDescriptiveName cp = M.member cp codeMap++nameToCodepoint :: String -> Maybe CodePoint+nameToCodepoint name+  | prefix == "uni" &&+    nDigits == 4 =+    Just $ foldl (\t d -> t*16 + fromIntegral (digitToInt d))+    0 hexNum+  | prefix == "u" &&+    nDigits >= 4 &&+    nDigits <= 6 =+    Just $ foldl (\t d -> t*16 + fromIntegral (digitToInt d))+    0 hexNum+  | otherwise = HM.lookup prefix nameMap+  where+    (prefix, r) = span isAlpha name+    hexNum = takeWhile isHexDigit r+    nDigits = length hexNum++nameMap :: HM.HashMap String CodePoint+nameMap = HM.fromList $ map swap aglfn++codeMap :: M.Map CodePoint String+codeMap = M.fromList aglfn++-- | index of the string in the list of standard postscript names, if any.+postscriptIndex :: String -> Maybe Int+postscriptIndex n = HM.lookup n postscriptIndexMap++-- | standard postscript name at index, if any.+postscriptName :: Int -> Maybe String+postscriptName i+  | i < 0 || i >= V.length postscriptNames = Nothing+  | otherwise = Just $ postscriptNames V.! i++postscriptIndexMap :: HM.HashMap String Int+postscriptIndexMap =+  HM.fromList $+  zip (V.toList postscriptNames) [1..]+                  +aglfn :: [(CodePoint, String)]+aglfn = [(0x0041,"A"),+         (0x00C6,"AE"),+         (0x01FC,"AEacute"),+         (0x00C1,"Aacute"),+         (0x0102,"Abreve"),+         (0x00C2,"Acircumflex"),+         (0x00C4,"Adieresis"),+         (0x00C0,"Agrave"),+         (0x0391,"Alpha"),+         (0x0386,"Alphatonos"),+         (0x0100,"Amacron"),+         (0x0104,"Aogonek"),+         (0x00C5,"Aring"),+         (0x01FA,"Aringacute"),+         (0x00C3,"Atilde"),+         (0x0042,"B"),+         (0x0392,"Beta"),+         (0x0043,"C"),+         (0x0106,"Cacute"),+         (0x010C,"Ccaron"),+         (0x00C7,"Ccedilla"),+         (0x0108,"Ccircumflex"),+         (0x010A,"Cdotaccent"),+         (0x03A7,"Chi"),+         (0x0044,"D"),+         (0x010E,"Dcaron"),+         (0x0110,"Dcroat"),+         (0x2206,"Delta"),+         (0x0045,"E"),+         (0x00C9,"Eacute"),+         (0x0114,"Ebreve"),+         (0x011A,"Ecaron"),+         (0x00CA,"Ecircumflex"),+         (0x00CB,"Edieresis"),+         (0x0116,"Edotaccent"),+         (0x00C8,"Egrave"),+         (0x0112,"Emacron"),+         (0x014A,"Eng"),+         (0x0118,"Eogonek"),+         (0x0395,"Epsilon"),+         (0x0388,"Epsilontonos"),+         (0x0397,"Eta"),+         (0x0389,"Etatonos"),+         (0x00D0,"Eth"),+         (0x20AC,"Euro"),+         (0x0046,"F"),+         (0x0047,"G"),+         (0x0393,"Gamma"),+         (0x011E,"Gbreve"),+         (0x01E6,"Gcaron"),+         (0x011C,"Gcircumflex"),+         (0x0120,"Gdotaccent"),+         (0x0048,"H"),+         (0x25CF,"H18533"),+         (0x25AA,"H18543"),+         (0x25AB,"H18551"),+         (0x25A1,"H22073"),+         (0x0126,"Hbar"),+         (0x0124,"Hcircumflex"),+         (0x0049,"I"),+         (0x0132,"IJ"),+         (0x00CD,"Iacute"),+         (0x012C,"Ibreve"),+         (0x00CE,"Icircumflex"),+         (0x00CF,"Idieresis"),+         (0x0130,"Idotaccent"),+         (0x2111,"Ifraktur"),+         (0x00CC,"Igrave"),+         (0x012A,"Imacron"),+         (0x012E,"Iogonek"),+         (0x0399,"Iota"),+         (0x03AA,"Iotadieresis"),+         (0x038A,"Iotatonos"),+         (0x0128,"Itilde"),+         (0x004A,"J"),+         (0x0134,"Jcircumflex"),+         (0x004B,"K"),+         (0x039A,"Kappa"),+         (0x004C,"L"),+         (0x0139,"Lacute"),+         (0x039B,"Lambda"),+         (0x013D,"Lcaron"),+         (0x013F,"Ldot"),+         (0x0141,"Lslash"),+         (0x004D,"M"),+         (0x039C,"Mu"),+         (0x004E,"N"),+         (0x0143,"Nacute"),+         (0x0147,"Ncaron"),+         (0x00D1,"Ntilde"),+         (0x039D,"Nu"),+         (0x004F,"O"),+         (0x0152,"OE"),+         (0x00D3,"Oacute"),+         (0x014E,"Obreve"),+         (0x00D4,"Ocircumflex"),+         (0x00D6,"Odieresis"),+         (0x00D2,"Ograve"),+         (0x01A0,"Ohorn"),+         (0x0150,"Ohungarumlaut"),+         (0x014C,"Omacron"),+         (0x2126,"Omega"),+         (0x038F,"Omegatonos"),+         (0x039F,"Omicron"),+         (0x038C,"Omicrontonos"),+         (0x00D8,"Oslash"),+         (0x01FE,"Oslashacute"),+         (0x00D5,"Otilde"),+         (0x0050,"P"),+         (0x03A6,"Phi"),+         (0x03A0,"Pi"),+         (0x03A8,"Psi"),+         (0x0051,"Q"),+         (0x0052,"R"),+         (0x0154,"Racute"),+         (0x0158,"Rcaron"),+         (0x211C,"Rfraktur"),+         (0x03A1,"Rho"),+         (0x0053,"S"),+         (0x250C,"SF010000"),+         (0x2514,"SF020000"),+         (0x2510,"SF030000"),+         (0x2518,"SF040000"),+         (0x253C,"SF050000"),+         (0x252C,"SF060000"),+         (0x2534,"SF070000"),+         (0x251C,"SF080000"),+         (0x2524,"SF090000"),+         (0x2500,"SF100000"),+         (0x2502,"SF110000"),+         (0x2561,"SF190000"),+         (0x2562,"SF200000"),+         (0x2556,"SF210000"),+         (0x2555,"SF220000"),+         (0x2563,"SF230000"),+         (0x2551,"SF240000"),+         (0x2557,"SF250000"),+         (0x255D,"SF260000"),+         (0x255C,"SF270000"),+         (0x255B,"SF280000"),+         (0x255E,"SF360000"),+         (0x255F,"SF370000"),+         (0x255A,"SF380000"),+         (0x2554,"SF390000"),+         (0x2569,"SF400000"),+         (0x2566,"SF410000"),+         (0x2560,"SF420000"),+         (0x2550,"SF430000"),+         (0x256C,"SF440000"),+         (0x2567,"SF450000"),+         (0x2568,"SF460000"),+         (0x2564,"SF470000"),+         (0x2565,"SF480000"),+         (0x2559,"SF490000"),+         (0x2558,"SF500000"),+         (0x2552,"SF510000"),+         (0x2553,"SF520000"),+         (0x256B,"SF530000"),+         (0x256A,"SF540000"),+         (0x015A,"Sacute"),+         (0x0160,"Scaron"),+         (0x015E,"Scedilla"),+         (0x015C,"Scircumflex"),+         (0x03A3,"Sigma"),+         (0x0054,"T"),+         (0x03A4,"Tau"),+         (0x0166,"Tbar"),+         (0x0164,"Tcaron"),+         (0x0398,"Theta"),+         (0x00DE,"Thorn"),+         (0x0055,"U"),+         (0x00DA,"Uacute"),+         (0x016C,"Ubreve"),+         (0x00DB,"Ucircumflex"),+         (0x00DC,"Udieresis"),+         (0x00D9,"Ugrave"),+         (0x01AF,"Uhorn"),+         (0x0170,"Uhungarumlaut"),+         (0x016A,"Umacron"),+         (0x0172,"Uogonek"),+         (0x03A5,"Upsilon"),+         (0x03D2,"Upsilon1"),+         (0x03AB,"Upsilondieresis"),+         (0x038E,"Upsilontonos"),+         (0x016E,"Uring"),+         (0x0168,"Utilde"),+         (0x0056,"V"),+         (0x0057,"W"),+         (0x1E82,"Wacute"),+         (0x0174,"Wcircumflex"),+         (0x1E84,"Wdieresis"),+         (0x1E80,"Wgrave"),+         (0x0058,"X"),+         (0x039E,"Xi"),+         (0x0059,"Y"),+         (0x00DD,"Yacute"),+         (0x0176,"Ycircumflex"),+         (0x0178,"Ydieresis"),+         (0x1EF2,"Ygrave"),+         (0x005A,"Z"),+         (0x0179,"Zacute"),+         (0x017D,"Zcaron"),+         (0x017B,"Zdotaccent"),+         (0x0396,"Zeta"),+         (0x0061,"a"),+         (0x00E1,"aacute"),+         (0x0103,"abreve"),+         (0x00E2,"acircumflex"),+         (0x00B4,"acute"),+         (0x0301,"acutecomb"),+         (0x00E4,"adieresis"),+         (0x00E6,"ae"),+         (0x01FD,"aeacute"),+         (0x00E0,"agrave"),+         (0x2135,"aleph"),+         (0x03B1,"alpha"),+         (0x03AC,"alphatonos"),+         (0x0101,"amacron"),+         (0x0026,"ampersand"),+         (0x2220,"angle"),+         (0x2329,"angleleft"),+         (0x232A,"angleright"),+         (0x0387,"anoteleia"),+         (0x0105,"aogonek"),+         (0x2248,"approxequal"),+         (0x00E5,"aring"),+         (0x01FB,"aringacute"),+         (0x2194,"arrowboth"),+         (0x21D4,"arrowdblboth"),+         (0x21D3,"arrowdbldown"),+         (0x21D0,"arrowdblleft"),+         (0x21D2,"arrowdblright"),+         (0x21D1,"arrowdblup"),+         (0x2193,"arrowdown"),+         (0x2190,"arrowleft"),+         (0x2192,"arrowright"),+         (0x2191,"arrowup"),+         (0x2195,"arrowupdn"),+         (0x21A8,"arrowupdnbse"),+         (0x005E,"asciicircum"),+         (0x007E,"asciitilde"),+         (0x002A,"asterisk"),+         (0x2217,"asteriskmath"),+         (0x0040,"at"),+         (0x00E3,"atilde"),+         (0x0062,"b"),+         (0x005C,"backslash"),+         (0x007C,"bar"),+         (0x03B2,"beta"),+         (0x2588,"block"),+         (0x007B,"braceleft"),+         (0x007D,"braceright"),+         (0x005B,"bracketleft"),+         (0x005D,"bracketright"),+         (0x02D8,"breve"),+         (0x00A6,"brokenbar"),+         (0x2022,"bullet"),+         (0x0063,"c"),+         (0x0107,"cacute"),+         (0x02C7,"caron"),+         (0x21B5,"carriagereturn"),+         (0x010D,"ccaron"),+         (0x00E7,"ccedilla"),+         (0x0109,"ccircumflex"),+         (0x010B,"cdotaccent"),+         (0x00B8,"cedilla"),+         (0x00A2,"cent"),+         (0x03C7,"chi"),+         (0x25CB,"circle"),+         (0x2297,"circlemultiply"),+         (0x2295,"circleplus"),+         (0x02C6,"circumflex"),+         (0x2663,"club"),+         (0x003A,"colon"),+         (0x20A1,"colonmonetary"),+         (0x002C,"comma"),+         (0x2245,"congruent"),+         (0x00A9,"copyright"),+         (0x00A4,"currency"),+         (0x0064,"d"),+         (0x2020,"dagger"),+         (0x2021,"daggerdbl"),+         (0x010F,"dcaron"),+         (0x0111,"dcroat"),+         (0x00B0,"degree"),+         (0x03B4,"delta"),+         (0x2666,"diamond"),+         (0x00A8,"dieresis"),+         (0x0385,"dieresistonos"),+         (0x00F7,"divide"),+         (0x2593,"dkshade"),+         (0x2584,"dnblock"),+         (0x0024,"dollar"),+         (0x20AB,"dong"),+         (0x02D9,"dotaccent"),+         (0x0323,"dotbelowcomb"),+         (0x0131,"dotlessi"),+         (0x22C5,"dotmath"),+         (0x0065,"e"),+         (0x00E9,"eacute"),+         (0x0115,"ebreve"),+         (0x011B,"ecaron"),+         (0x00EA,"ecircumflex"),+         (0x00EB,"edieresis"),+         (0x0117,"edotaccent"),+         (0x00E8,"egrave"),+         (0x0038,"eight"),+         (0x2208,"element"),+         (0x2026,"ellipsis"),+         (0x0113,"emacron"),+         (0x2014,"emdash"),+         (0x2205,"emptyset"),+         (0x2013,"endash"),+         (0x014B,"eng"),+         (0x0119,"eogonek"),+         (0x03B5,"epsilon"),+         (0x03AD,"epsilontonos"),+         (0x003D,"equal"),+         (0x2261,"equivalence"),+         (0x212E,"estimated"),+         (0x03B7,"eta"),+         (0x03AE,"etatonos"),+         (0x00F0,"eth"),+         (0x0021,"exclam"),+         (0x203C,"exclamdbl"),+         (0x00A1,"exclamdown"),+         (0x2203,"existential"),+         (0x0066,"f"),+         (0x2640,"female"),+         (0x2012,"figuredash"),+         (0x25A0,"filledbox"),+         (0x25AC,"filledrect"),+         (0x0035,"five"),+         (0x215D,"fiveeighths"),+         (0x0192,"florin"),+         (0x0034,"four"),+         (0x2044,"fraction"),+         (0x20A3,"franc"),+         (0x0067,"g"),+         (0x03B3,"gamma"),+         (0x011F,"gbreve"),+         (0x01E7,"gcaron"),+         (0x011D,"gcircumflex"),+         (0x0121,"gdotaccent"),+         (0x00DF,"germandbls"),+         (0x2207,"gradient"),+         (0x0060,"grave"),+         (0x0300,"gravecomb"),+         (0x003E,"greater"),+         (0x2265,"greaterequal"),+         (0x00AB,"guillemotleft"),+         (0x00BB,"guillemotright"),+         (0x2039,"guilsinglleft"),+         (0x203A,"guilsinglright"),+         (0x0068,"h"),+         (0x0127,"hbar"),+         (0x0125,"hcircumflex"),+         (0x2665,"heart"),+         (0x0309,"hookabovecomb"),+         (0x2302,"house"),+         (0x02DD,"hungarumlaut"),+         (0x002D,"hyphen"),+         (0x0069,"i"),+         (0x00ED,"iacute"),+         (0x012D,"ibreve"),+         (0x00EE,"icircumflex"),+         (0x00EF,"idieresis"),+         (0x00EC,"igrave"),+         (0x0133,"ij"),+         (0x012B,"imacron"),+         (0x221E,"infinity"),+         (0x222B,"integral"),+         (0x2321,"integralbt"),+         (0x2320,"integraltp"),+         (0x2229,"intersection"),+         (0x25D8,"invbullet"),+         (0x25D9,"invcircle"),+         (0x263B,"invsmileface"),+         (0x012F,"iogonek"),+         (0x03B9,"iota"),+         (0x03CA,"iotadieresis"),+         (0x0390,"iotadieresistonos"),+         (0x03AF,"iotatonos"),+         (0x0129,"itilde"),+         (0x006A,"j"),+         (0x0135,"jcircumflex"),+         (0x006B,"k"),+         (0x03BA,"kappa"),+         (0x0138,"kgreenlandic"),+         (0x006C,"l"),+         (0x013A,"lacute"),+         (0x03BB,"lambda"),+         (0x013E,"lcaron"),+         (0x0140,"ldot"),+         (0x003C,"less"),+         (0x2264,"lessequal"),+         (0x258C,"lfblock"),+         (0x20A4,"lira"),+         (0x2227,"logicaland"),+         (0x00AC,"logicalnot"),+         (0x2228,"logicalor"),+         (0x017F,"longs"),+         (0x25CA,"lozenge"),+         (0x0142,"lslash"),+         (0x2591,"ltshade"),+         (0x006D,"m"),+         (0x00AF,"macron"),+         (0x2642,"male"),+         (0x2212,"minus"),+         (0x2032,"minute"),+         (0x00B5,"mu"),+         (0x00D7,"multiply"),+         (0x266A,"musicalnote"),+         (0x266B,"musicalnotedbl"),+         (0x006E,"n"),+         (0x0144,"nacute"),+         (0x0149,"napostrophe"),+         (0x0148,"ncaron"),+         (0x0039,"nine"),+         (0x2209,"notelement"),+         (0x2260,"notequal"),+         (0x2284,"notsubset"),+         (0x00F1,"ntilde"),+         (0x03BD,"nu"),+         (0x0023,"numbersign"),+         (0x006F,"o"),+         (0x00F3,"oacute"),+         (0x014F,"obreve"),+         (0x00F4,"ocircumflex"),+         (0x00F6,"odieresis"),+         (0x0153,"oe"),+         (0x02DB,"ogonek"),+         (0x00F2,"ograve"),+         (0x01A1,"ohorn"),+         (0x0151,"ohungarumlaut"),+         (0x014D,"omacron"),+         (0x03C9,"omega"),+         (0x03D6,"omega1"),+         (0x03CE,"omegatonos"),+         (0x03BF,"omicron"),+         (0x03CC,"omicrontonos"),+         (0x0031,"one"),+         (0x2024,"onedotenleader"),+         (0x215B,"oneeighth"),+         (0x00BD,"onehalf"),+         (0x00BC,"onequarter"),+         (0x2153,"onethird"),+         (0x25E6,"openbullet"),+         (0x00AA,"ordfeminine"),+         (0x00BA,"ordmasculine"),+         (0x221F,"orthogonal"),+         (0x00F8,"oslash"),+         (0x01FF,"oslashacute"),+         (0x00F5,"otilde"),+         (0x0070,"p"),+         (0x00B6,"paragraph"),+         (0x0028,"parenleft"),+         (0x0029,"parenright"),+         (0x2202,"partialdiff"),+         (0x0025,"percent"),+         (0x002E,"period"),+         (0x00B7,"periodcentered"),+         (0x22A5,"perpendicular"),+         (0x2030,"perthousand"),+         (0x20A7,"peseta"),+         (0x03C6,"phi"),+         (0x03D5,"phi1"),+         (0x03C0,"pi"),+         (0x002B,"plus"),+         (0x00B1,"plusminus"),+         (0x211E,"prescription"),+         (0x220F,"product"),+         (0x2282,"propersubset"),+         (0x2283,"propersuperset"),+         (0x221D,"proportional"),+         (0x03C8,"psi"),+         (0x0071,"q"),+         (0x003F,"question"),+         (0x00BF,"questiondown"),+         (0x0022,"quotedbl"),+         (0x201E,"quotedblbase"),+         (0x201C,"quotedblleft"),+         (0x201D,"quotedblright"),+         (0x2018,"quoteleft"),+         (0x201B,"quotereversed"),+         (0x2019,"quoteright"),+         (0x201A,"quotesinglbase"),+         (0x0027,"quotesingle"),+         (0x0072,"r"),+         (0x0155,"racute"),+         (0x221A,"radical"),+         (0x0159,"rcaron"),+         (0x2286,"reflexsubset"),+         (0x2287,"reflexsuperset"),+         (0x00AE,"registered"),+         (0x2310,"revlogicalnot"),+         (0x03C1,"rho"),+         (0x02DA,"ring"),+         (0x2590,"rtblock"),+         (0x0073,"s"),+         (0x015B,"sacute"),+         (0x0161,"scaron"),+         (0x015F,"scedilla"),+         (0x015D,"scircumflex"),+         (0x2033,"second"),+         (0x00A7,"section"),+         (0x003B,"semicolon"),+         (0x0037,"seven"),+         (0x215E,"seveneighths"),+         (0x2592,"shade"),+         (0x03C3,"sigma"),+         (0x03C2,"sigma1"),+         (0x223C,"similar"),+         (0x0036,"six"),+         (0x002F,"slash"),+         (0x263A,"smileface"),+         (0x0020,"space"),+         (0x2660,"spade"),+         (0x00A3,"sterling"),+         (0x220B,"suchthat"),+         (0x2211,"summation"),+         (0x263C,"sun"),+         (0x0074,"t"),+         (0x03C4,"tau"),+         (0x0167,"tbar"),+         (0x0165,"tcaron"),+         (0x2234,"therefore"),+         (0x03B8,"theta"),+         (0x03D1,"theta1"),+         (0x00FE,"thorn"),+         (0x0033,"three"),+         (0x215C,"threeeighths"),+         (0x00BE,"threequarters"),+         (0x02DC,"tilde"),+         (0x0303,"tildecomb"),+         (0x0384,"tonos"),+         (0x2122,"trademark"),+         (0x25BC,"triagdn"),+         (0x25C4,"triaglf"),+         (0x25BA,"triagrt"),+         (0x25B2,"triagup"),+         (0x0032,"two"),+         (0x2025,"twodotenleader"),+         (0x2154,"twothirds"),+         (0x0075,"u"),+         (0x00FA,"uacute"),+         (0x016D,"ubreve"),+         (0x00FB,"ucircumflex"),+         (0x00FC,"udieresis"),+         (0x00F9,"ugrave"),+         (0x01B0,"uhorn"),+         (0x0171,"uhungarumlaut"),+         (0x016B,"umacron"),+         (0x005F,"underscore"),+         (0x2017,"underscoredbl"),+         (0x222A,"union"),+         (0x2200,"universal"),+         (0x0173,"uogonek"),+         (0x2580,"upblock"),+         (0x03C5,"upsilon"),+         (0x03CB,"upsilondieresis"),+         (0x03B0,"upsilondieresistonos"),+         (0x03CD,"upsilontonos"),+         (0x016F,"uring"),+         (0x0169,"utilde"),+         (0x0076,"v"),+         (0x0077,"w"),+         (0x1E83,"wacute"),+         (0x0175,"wcircumflex"),+         (0x1E85,"wdieresis"),+         (0x2118,"weierstrass"),+         (0x1E81,"wgrave"),+         (0x0078,"x"),+         (0x03BE,"xi"),+         (0x0079,"y"),+         (0x00FD,"yacute"),+         (0x0177,"ycircumflex"),+         (0x00FF,"ydieresis"),+         (0x00A5,"yen"),+         (0x1EF3,"ygrave"),+         (0x007A,"z"),+         (0x017A,"zacute"),+         (0x017E,"zcaron"),+         (0x017C,"zdotaccent"),+         (0x0030,"zero"),+         (0x03B6,"zeta")]++-- | vector of standard postscript names.+postscriptNames :: V.Vector String+postscriptNames =+  V.fromList+  [".notdef",+   ".null",+   "nonmarkingreturn",+   "space",+   "exclam",+   "quotedbl",+   "numbersign",+   "dollar",+   "percent",+   "ampersand",+   "quotesingle",+   "parenleft",+   "parenright",+   "asterisk",+   "plus",+   "comma",+   "hyphen",+   "period",+   "slash",+   "zero",+   "one",+   "two",+   "three",+   "four",+   "five",+   "six",+   "seven",+   "eight",+   "nine",+   "colon",+   "semicolon",+   "less",+   "equal",+   "greater",+   "question",+   "at",+   "A",+   "B",+   "C",+   "D",+   "E",+   "F",+   "G",+   "H",+   "I",+   "J",+   "K",+   "L",+   "M",+   "N",+   "O",+   "P",+   "Q",+   "R",+   "S",+   "T",+   "U",+   "V",+   "W",+   "X",+   "Y",+   "Z",+   "bracketleft",+   "backslash",+   "bracketright",+   "asciicircum",+   "underscore",+   "grave",+   "a",+   "b",+   "c",+   "d",+   "e",+   "f",+   "g",+   "h",+   "i",+   "j",+   "k",+   "l",+   "m",+   "n",+   "o",+   "p",+   "q",+   "r",+   "s",+   "t",+   "u",+   "v",+   "w",+   "x",+   "y",+   "z",+   "braceleft",+   "bar",+   "braceright",+   "asciitilde",+   "Adieresis",+   "Aring",+   "Ccedilla",+   "Eacute",+   "Ntilde",+   "Odieresis",+   "Udieresis",+   "aacute",+   "agrave",+   "acircumflex",+   "adieresis",+   "atilde",+   "aring",+   "ccedilla",+   "eacute",+   "egrave",+   "ecircumflex",+   "edieresis",+   "iacute",+   "igrave",+   "icircumflex",+   "idieresis",+   "ntilde",+   "oacute",+   "ograve",+   "ocircumflex",+   "odieresis",+   "otilde",+   "uacute",+   "ugrave",+   "ucircumflex",+   "udieresis",+   "dagger",+   "degree",+   "cent",+   "sterling",+   "section",+   "bullet",+   "paragraph",+   "germandbls",+   "registered",+   "copyright",+   "trademark",+   "acute",+   "dieresis",+   "notequal",+   "AE",+   "Oslash",+   "infinity",+   "plusminus",+   "lessequal",+   "greaterequal",+   "yen",+   "mu",+   "partialdiff",+   "summation",+   "product",+   "pi",+   "integral",+   "ordfeminine",+   "ordmasculine",+   "Omega",+   "ae",+   "oslash",+   "questiondown",+   "exclamdown",+   "logicalnot",+   "radical",+   "florin",+   "approxequal",+   "Delta",+   "guillemotleft",+   "guillemotright",+   "ellipsis",+   "nonbreakingspace",+   "Agrave",+   "Atilde",+   "Otilde",+   "OE",+   "oe",+   "endash",+   "emdash",+   "quotedblleft",+   "quotedblright",+   "quoteleft",+   "quoteright",+   "divide",+   "lozenge",+   "ydieresis",+   "Ydieresis",+   "fraction",+   "currency",+   "guilsinglleft",+   "guilsinglright",+   "fi",+   "fl",+   "daggerdbl",+   "periodcentered",+   "quotesinglbase",+   "quotedblbase",+   "perthousand",+   "Acircumflex",+   "Ecircumflex",+   "Aacute",+   "Edieresis",+   "Egrave",+   "Iacute",+   "Icircumflex",+   "Idieresis",+   "Igrave",+   "Oacute",+   "Ocircumflex",+   "apple",+   "Ograve",+   "Uacute",+   "Ucircumflex",+   "Ugrave",+   "dotlessi",+   "circumflex",+   "tilde",+   "macron",+   "breve",+   "dotaccent",+   "ring",+   "cedilla",+   "hungarumlaut",+   "ogonek",+   "caron",+   "Lslash",+   "lslash",+   "Scaron",+   "scaron",+   "Zcaron",+   "zcaron",+   "brokenbar",+   "Eth",+   "eth",+   "Yacute",+   "yacute",+   "Thorn",+   "thorn",+   "minus",+   "multiply",+   "onesuperior",+   "twosuperior",+   "threesuperior",+   "onehalf",+   "onequarter",+   "threequarters",+   "franc",+   "Gbreve",+   "gbreve",+   "Idotaccent",+   "Scedilla",+   "scedilla",+   "Cacute",+   "cacute",+   "Ccaron",+   "ccaron",+   "dcroat"]

@@ -1,5 +1,5 @@ name: opentype-version: 0.0.1+version: 0.1.0 cabal-version: >=1.8 build-type: Simple license: BSD3@@ -20,10 +20,22 @@   library   build-depends:-    base >=3 && <5, binary >=0.8.1.0,-    bytestring >0.10.0, containers >=0.5.3, ghc >=7.10.0, time >1.4.0,-    vector >=0.10, pretty-hex >=1.0-  exposed-modules: Opentype.Fileformat+                base >=3 && <5,+                binary >=0.8.1.0,+                bytestring >0.10.0,+                containers >=0.5.3,+                ghc >=7.10.0,+                microlens > 0.4.0.0,+                microlens-th > 0.4.0.0,+                mtl >= 2.2.1,+                pretty-hex >=1.0,+                time >1.4.0,+                unordered-containers >0.2.6.0,+                vector >=0.10+  exposed-modules:+                  Opentype.Fileformat+                  Opentype.Fileformat.Unicode+                  Opentype.Fileformat.FontInfo   exposed: True   buildable: True   other-modules:@@ -37,6 +49,7 @@     Opentype.Fileformat.Post     Opentype.Fileformat.Kern     Opentype.Fileformat.OS2+    Opentype.Fileformat.Unicode.PostNames       ghc-options: -Wall   test-suite test