webify 0.1.6.0 → 0.1.7.0
raw patch · 8 files changed
+260/−244 lines, 8 filesdep +blaze-builderdep ~basedep ~binary-strictdep ~optparse-applicative
Dependencies added: blaze-builder
Dependency ranges changed: base, binary-strict, optparse-applicative, xmlgen
Files
- src/EOT.hs +9/−9
- src/Font.hs +71/−72
- src/OTF.hs +12/−12
- src/SVG.hs +26/−23
- src/TTF.hs +114/−114
- src/Utils.hs +20/−7
- src/Webify.hs +2/−2
- webify.cabal +6/−5
src/EOT.hs view
@@ -2,15 +2,15 @@ generate ) where -import Control.Monad-import Data.Binary.Put-import Data.Bits-import qualified Data.ByteString as B-import Data.List (find)-import Data.Maybe (fromJust, isJust)-import Data.Text.Encoding (encodeUtf16LE)-import Font-import Utils+import Control.Monad+import Data.Binary.Put+import Data.Bits+import qualified Data.ByteString as B+import Data.List (find)+import Data.Maybe (fromJust, isJust)+import Data.Text.Encoding (encodeUtf16LE)+import Font+import Utils putULong :: ULong -> Put putULong = putWord32le
src/Font.hs view
@@ -40,18 +40,18 @@ , parseName ) where -import Control.Monad-import Data.Binary.Strict.Get-import qualified Data.ByteString as B-import Data.ByteString.Char8 (unpack)-import Data.Int-import Data.Map hiding(map)-import qualified Data.Text as T-import Data.Text.Encoding.Error-import qualified Data.Vector as V-import Data.Word-import Utils-import Data.Text.Encoding+import Control.Monad+import Data.Binary.Strict.Get+import qualified Data.ByteString as B+import Data.ByteString.Char8 (unpack)+import Data.Int+import Data.Map hiding (map)+import qualified Data.Text as T+import Data.Text.Encoding+import Data.Text.Encoding.Error+import qualified Data.Vector as V+import Data.Word+import Utils -- font data types @@ -65,7 +65,6 @@ -- type Long = Int32 type Fixed = Word32 - getFixed :: Get Fixed getFixed = liftM fromIntegral getWord32be @@ -96,68 +95,68 @@ --- common parsing utils-data TableDirectory = TableDirectory { tDTag :: String+data TableDirectory = TableDirectory { tDTag :: String , tDCheckSum :: ULong- , tDOffset :: ULong- , tDLength :: ULong- , tDRawData :: B.ByteString+ , tDOffset :: ULong+ , tDLength :: ULong+ , tDRawData :: B.ByteString } deriving (Show) -data NameRecord = NameRecord { platformId :: UShort+data NameRecord = NameRecord { platformId :: UShort , encodingId :: UShort , languageId :: UShort- , nameId :: UShort- , strLength :: UShort- , strOffset :: UShort- , str :: T.Text+ , nameId :: UShort+ , strLength :: UShort+ , strOffset :: UShort+ , str :: T.Text } deriving (Show) -data Name = Name { formatSelector :: UShort+data Name = Name { formatSelector :: UShort , numberOfNameRecords :: UShort- , storageOffset :: UShort- , nameRecords :: [NameRecord]+ , storageOffset :: UShort+ , nameRecords :: [NameRecord] } deriving (Show) data HMetric = HMetric { advanceWidth :: UFWord- , lsb :: FWord+ , lsb :: FWord } deriving (Show) -data Hmtx = Hmtx { hMetrics :: V.Vector HMetric+data Hmtx = Hmtx { hMetrics :: V.Vector HMetric , leftSideBearings :: [FWord] } deriving (Show) -data OS2 = OS2 { os2Version :: UShort- , xAvgCharWidth :: Short- , usWeightClass :: UShort- , usWidthClass :: UShort- , fsType :: UShort- , ySubscriptXSize :: Short- , ySubscriptYSize :: Short- , ySubscriptXOffset :: Short- , ySubscriptYOffset :: Short- , ySuperscriptXSize :: Short- , ySuperscriptYSize :: Short+data OS2 = OS2 { os2Version :: UShort+ , xAvgCharWidth :: Short+ , usWeightClass :: UShort+ , usWidthClass :: UShort+ , fsType :: UShort+ , ySubscriptXSize :: Short+ , ySubscriptYSize :: Short+ , ySubscriptXOffset :: Short+ , ySubscriptYOffset :: Short+ , ySuperscriptXSize :: Short+ , ySuperscriptYSize :: Short , ySuperscriptXOffset :: Short , ySuperscriptYOffset :: Short- , yStrikeoutSize :: Short- , yStrikeoutPosition :: Short- , sFamilyClass :: Short- , panose :: [Byte]- , ulUnicodeRange1 :: ULong- , ulUnicodeRange2 :: ULong- , ulUnicodeRange3 :: ULong- , ulUnicodeRange4 :: ULong- , aschVendID :: [Byte]- , fsSelection :: UShort- , usFirstCharIndex :: UShort- , usLastCharIndex :: UShort- , sTypoAscender :: UShort- , sTypoDescender :: UShort- , sTypoLineGap :: UShort- , usWinAscent :: UShort- , usWinDescent :: UShort- , ulCodePageRange1 :: ULong- , ulCodePageRange2 :: ULong+ , yStrikeoutSize :: Short+ , yStrikeoutPosition :: Short+ , sFamilyClass :: Short+ , panose :: [Byte]+ , ulUnicodeRange1 :: ULong+ , ulUnicodeRange2 :: ULong+ , ulUnicodeRange3 :: ULong+ , ulUnicodeRange4 :: ULong+ , aschVendID :: [Byte]+ , fsSelection :: UShort+ , usFirstCharIndex :: UShort+ , usLastCharIndex :: UShort+ , sTypoAscender :: UShort+ , sTypoDescender :: UShort+ , sTypoLineGap :: UShort+ , usWinAscent :: UShort+ , usWinDescent :: UShort+ , ulCodePageRange1 :: ULong+ , ulCodePageRange2 :: ULong } deriving (Show) parseTableDirectory :: B.ByteString -> Get TableDirectory@@ -217,23 +216,23 @@ ulCodePageRange2 <- getULong return OS2 {..}) -data Head = Head { headVersion :: Fixed- , fontRevision :: Fixed+data Head = Head { headVersion :: Fixed+ , fontRevision :: Fixed , checkSumAdjusment :: ULong- , magicNumber :: ULong- , headFlags :: UShort- , unitsPerEm :: UShort- , created :: B.ByteString- , modified :: B.ByteString- , xMin :: FWord- , yMin :: FWord- , xMax :: FWord- , yMax :: FWord- , macStyle :: UShort- , lowestRecPPEM :: UShort+ , magicNumber :: ULong+ , headFlags :: UShort+ , unitsPerEm :: UShort+ , created :: B.ByteString+ , modified :: B.ByteString+ , xMin :: FWord+ , yMin :: FWord+ , xMax :: FWord+ , yMax :: FWord+ , macStyle :: UShort+ , lowestRecPPEM :: UShort , fontDirectionHint :: Short- , indexToLocFormat :: Short- , glyphDataFormat :: Short+ , indexToLocFormat :: Short+ , glyphDataFormat :: Short } deriving (Show) parseHead :: Map String TableDirectory -> B.ByteString -> Head
src/OTF.hs view
@@ -6,10 +6,10 @@ , parse ) where -import qualified Data.ByteString as B-import Data.Binary.Strict.Get-import Data.Map-import Font+import Data.Binary.Strict.Get+import qualified Data.ByteString as B+import Data.Map+import Font instance Font OTF where version = OTF.version@@ -27,15 +27,15 @@ headCheckSumAdjusment = checkSumAdjusment . OTF.head name = OTF.name -data OTF = OTF { version :: Fixed- , numTables :: UShort- , searchRange :: UShort- , entrySelector :: UShort- , rangeShift :: UShort+data OTF = OTF { version :: Fixed+ , numTables :: UShort+ , searchRange :: UShort+ , entrySelector :: UShort+ , rangeShift :: UShort , tableDirectories :: Map String TableDirectory- , os2 :: OS2- , head :: Head- , name :: Name+ , os2 :: OS2+ , head :: Head+ , name :: Name } deriving (Show) parse :: B.ByteString -> Get OTF
src/SVG.hs view
@@ -1,20 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+ module SVG( generate ) where -import Data.Bits-import qualified Data.ByteString as B-import Data.Char-import Data.List (find, foldl', intercalate)-import Data.Maybe (fromJust)-import qualified Data.Text as T-import qualified Data.Map as M-import TTF-import Font hiding (Char, name)-import Text.XML.Generator-import Numeric-import Utils-import Data.Vector as V ((!), length, last)+import Data.Bits+import qualified Data.ByteString as B+import Data.Char+import Data.List (find, foldl', intercalate)+import qualified Data.Map as M+import Data.Maybe (fromJust)+import qualified Data.Text ()+import qualified Data.Text as T+import Data.Vector as V (last, length, (!))+import Font hiding (Char, name)+import Numeric+import Text.XML.Generator hiding (xattr)+import TTF+import Utils byNameId :: UShort -> TTF -> T.Text byNameId id' ttf =@@ -149,8 +152,8 @@ missingGlyph :: TTF -> Xml Elem missingGlyph ttf =- xelem "missing-glyph" (xattrs [xattr "horiz-adv-x" $ show $ advanceX (hmtx ttf) 0,- xattr "d" $ svgPath glyph ttf])+ xelem "missing-glyph" (xattrs [xattr "horiz-adv-x" $ T.pack $ show $ advanceX (hmtx ttf) 0,+ xattr "d" $ T.pack $ svgPath glyph ttf]) where glyph = glyfs ttf ! 0 @@ -174,9 +177,9 @@ fontFace :: TTF -> Xml Elem fontFace ttf = xelem "font-face" (xattrs [xattr "font-family" $ fontFamilyName ttf,- xattr "units-per-em" $ show . unitsPerEm $ TTF.head ttf,- xattr "ascent" $ show . ascender $ hhea ttf,- xattr "descent" $ show . descender $ hhea ttf])+ xattr "units-per-em" $ T.pack . show . unitsPerEm $ TTF.head ttf,+ xattr "ascent" $ T.pack . show . ascender $ hhea ttf,+ xattr "descent" $ T.pack . show . descender $ hhea ttf]) svgKern :: M.Map Int [Int] -> KernPair -> Xml Elem@@ -184,7 +187,7 @@ kpValue = value, kTCoverage = coverage} = xelem ktype (xattrs [xattrRaw "u1" $ unicode left, xattrRaw "u2" $ unicode right,- xattr "k" $ show (-value)])+ xattr "k" $ T.pack $ show (-value)]) where unicode code = intercalate "," $ map (escapeXMLChar . chr . fromIntegral) (glyphIdToCodeMap M.! fromIntegral code) ktype = if testBit coverage 0 then "hkern" else "vkern" @@ -209,20 +212,20 @@ testText :: TTF -> Xml Elem testText ttf =- xelem "g" (xattr "style" ("font-family: " ++ show (fontFamilyName ttf) ++ "; font-size:50;fill:black") <#>+ xelem "g" (xattr "style" (T.pack $ "font-family: " ++ show (fontFamilyName ttf) ++ "; font-size:50;fill:black") <#> xelems (zipWith text ["!\"#$%&'()*+,-./0123456789:;å<>?", "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_", "` abcdefghijklmnopqrstuvwxyz|{}~"] [1..])) where text :: String -> Int -> Xml Elem text t i = xelem "text" (xattrs [xattr "x" "20",- xattr "y" $ show (i * 50)] <#> xtext t)+ xattr "y" $ T.pack $ show (i * 50)] <#> xtext (T.pack t)) svgbody :: TTF -> CmapTable -> Bool -> Xml Elem svgbody ttf cmapTable enableKern = xelems [xelemEmpty "metadata",- xelem "defs" $- xelem "font" (xattrs [xattr "horiz-adv-x" $ show avgAdvanceX] <#>+ xelem (T.pack "defs") $+ xelem "font" (xattrs [xattr "horiz-adv-x" $ T.pack $ show avgAdvanceX] <#> xelems ([fontFace ttf, glyps] ++ svgKerns ttf cmapTable enableKern)), testText ttf]
src/TTF.hs view
@@ -23,16 +23,16 @@ , kernPairs ) where -import Control.Monad-import Data.Binary.Strict.Get-import Data.Bits-import qualified Data.ByteString as B-import Data.List-import Data.Map hiding(map, findIndex)-import Data.Maybe-import qualified Data.Vector as V-import Utils-import Font+import Control.Monad+import Data.Binary.Strict.Get+import Data.Bits+import qualified Data.ByteString as B+import Data.List+import Data.Map hiding (findIndex, map)+import Data.Maybe+import qualified Data.Vector as V+import Font+import Utils instance Font TTF where@@ -53,161 +53,161 @@ data F12Group = F12Group { f12StartCharCode :: ULong- , f12EndCharCode :: ULong- , f12StartGlyphId :: ULong+ , f12EndCharCode :: ULong+ , f12StartGlyphId :: ULong } deriving (Show) -data CmapTable = CmapFormat0 { c0Format :: UShort- , c0Length :: UShort- , c0Version :: UShort+data CmapTable = CmapFormat0 { c0Format :: UShort+ , c0Length :: UShort+ , c0Version :: UShort , c0GlyphIDs :: [Byte] } |- CmapFormat4 { c4Format :: UShort- , c4Length :: UShort- , c4Language :: UShort- , c4SegCountX2 :: UShort- , c4SearchRange :: UShort- , c4EntrySelector :: UShort- , c4RangeShift :: UShort- , c4EndCodes :: [UShort]- , c4ReservedPad :: UShort- , c4StartCodes :: [UShort]- , c4IdDeltas :: [UShort]+ CmapFormat4 { c4Format :: UShort+ , c4Length :: UShort+ , c4Language :: UShort+ , c4SegCountX2 :: UShort+ , c4SearchRange :: UShort+ , c4EntrySelector :: UShort+ , c4RangeShift :: UShort+ , c4EndCodes :: [UShort]+ , c4ReservedPad :: UShort+ , c4StartCodes :: [UShort]+ , c4IdDeltas :: [UShort] , c4IdRangeOffsets :: [UShort]- , c4GlyphIds :: [UShort]+ , c4GlyphIds :: [UShort] } |- CmapFormat6 { c6Format :: UShort- , c6Length :: UShort- , c6Version :: UShort- , c6FirstCode :: UShort+ CmapFormat6 { c6Format :: UShort+ , c6Length :: UShort+ , c6Version :: UShort+ , c6FirstCode :: UShort , c6EntryCount :: UShort- , c6GlyphIds :: [UShort]+ , c6GlyphIds :: [UShort] } |- CmapFormat12 { c12Format :: Fixed- , c12Length :: ULong+ CmapFormat12 { c12Format :: Fixed+ , c12Length :: ULong , c12Language :: ULong- , c12NGroups :: ULong- , c12Groups :: [F12Group]+ , c12NGroups :: ULong+ , c12Groups :: [F12Group] } deriving (Show) data CmapEncodingDirectory = CmapEncodingDirectory { cmapPlatformId :: UShort , cmapEncodingId :: UShort- , cmapOffset :: ULong+ , cmapOffset :: ULong } deriving (Show) -data Cmap = Cmap { cmapVersion :: UShort- , numberOfSubtables :: UShort+data Cmap = Cmap { cmapVersion :: UShort+ , numberOfSubtables :: UShort , encodingDirectories :: [CmapEncodingDirectory]- , subTables :: [CmapTable]+ , subTables :: [CmapTable] } deriving (Show) -data Hhea = Hhea { hheaVersion :: Fixed- , ascender :: FWord- , descender :: FWord- , lineGap :: FWord- , advanceWidthMax :: UFWord- , minLeftSideBearing :: FWord+data Hhea = Hhea { hheaVersion :: Fixed+ , ascender :: FWord+ , descender :: FWord+ , lineGap :: FWord+ , advanceWidthMax :: UFWord+ , minLeftSideBearing :: FWord , minRightSideBearing :: FWord- , xMaxExtend :: FWord- , caretSlopeRise :: Short- , caretSlopeRun :: Short+ , xMaxExtend :: FWord+ , caretSlopeRise :: Short+ , caretSlopeRun :: Short -- reserved 5 Short- , metricDataFormat :: Short- , numberOfHMetrics :: UShort+ , metricDataFormat :: Short+ , numberOfHMetrics :: UShort } deriving (Show) -data Maxp = Maxp { maxVersion :: Fixed- , numGlyphs :: UShort- , maxPoints :: UShort- , maxContours :: UShort- , maxCompositePoints :: UShort- , maxCompositeContours :: UShort- , maxZones :: UShort- , maxTwilightPoints :: UShort- , maxStorage :: UShort- , maxFunctionDefs :: UShort- , maxInstructionDefs :: UShort- , maxStackElements :: UShort+data Maxp = Maxp { maxVersion :: Fixed+ , numGlyphs :: UShort+ , maxPoints :: UShort+ , maxContours :: UShort+ , maxCompositePoints :: UShort+ , maxCompositeContours :: UShort+ , maxZones :: UShort+ , maxTwilightPoints :: UShort+ , maxStorage :: UShort+ , maxFunctionDefs :: UShort+ , maxInstructionDefs :: UShort+ , maxStackElements :: UShort , maxSizeOfInstructions :: UShort- , maxComponentElements :: UShort- , maxComponentDepth :: UShort+ , maxComponentElements :: UShort+ , maxComponentDepth :: UShort } deriving (Show) data Loca = Loca { locaOffsets :: [ULong] } deriving (Show) -data CompositeGlyfElement = CompositeGlyfElement {cFlags :: UShort+data CompositeGlyfElement = CompositeGlyfElement {cFlags :: UShort , cGlyphIndex :: UShort- , cXoffset :: Short- , cYoffset :: Short- , cArgument1 :: Short- , cArgument2 :: Short- , cXScale :: Double- , cYScale :: Double- , cScale01 :: Double- , cScale10 :: Double+ , cXoffset :: Short+ , cYoffset :: Short+ , cArgument1 :: Short+ , cArgument2 :: Short+ , cXScale :: Double+ , cYScale :: Double+ , cScale01 :: Double+ , cScale10 :: Double } deriving (Show) data Glyf = EmptyGlyf |- SimpleGlyf { sNumberOfContours :: Short- , sXMin :: FWord- , sYMin :: FWord- , sXMax :: FWord- , sYMax :: FWord+ SimpleGlyf { sNumberOfContours :: Short+ , sXMin :: FWord+ , sYMin :: FWord+ , sXMax :: FWord+ , sYMax :: FWord , sEndPtsOfCountours :: [UShort] , sInstructionLength :: UShort- , sInstructions :: [Byte]- , sFlags :: [Byte]- , sXCoordinates :: [Short]- , sYCoordinates :: [Short]+ , sInstructions :: [Byte]+ , sFlags :: [Byte]+ , sXCoordinates :: [Short]+ , sYCoordinates :: [Short] } | CompositeGlyf { cNumberOfContours :: Short- , cXMin :: FWord- , cYMin :: FWord- , cXMax :: FWord- , cYMax :: FWord- , cGlyfs :: [CompositeGlyfElement]- , cNumInstruction :: UShort- , cInstructions :: [Byte]+ , cXMin :: FWord+ , cYMin :: FWord+ , cXMax :: FWord+ , cYMax :: FWord+ , cGlyfs :: [CompositeGlyfElement]+ , cNumInstruction :: UShort+ , cInstructions :: [Byte] } deriving (Show) -data KernPair = KernPair { kpLeft :: UShort- , kpRight :: UShort- , kpValue :: Short+data KernPair = KernPair { kpLeft :: UShort+ , kpRight :: UShort+ , kpValue :: Short , kTCoverage :: UShort } deriving (Show) -data KernTable = KernSubTable0 { kNPairs :: UShort- , kSearchRange :: UShort+data KernTable = KernSubTable0 { kNPairs :: UShort+ , kSearchRange :: UShort , kEntrySelector :: UShort- , kRangeShift :: UShort- , kKernPairs :: [KernPair] }+ , kRangeShift :: UShort+ , kKernPairs :: [KernPair] } | KernUnknown deriving (Show) -data Kern = Kern { kernVersion :: UShort+data Kern = Kern { kernVersion :: UShort , kernNumberOfSubtables :: UShort- , kernTables :: [KernTable]+ , kernTables :: [KernTable] } deriving (Show) -data TTF = TTF { version :: Fixed- , numTables :: UShort- , searchRange :: UShort- , entrySelector :: UShort- , rangeShift :: UShort+data TTF = TTF { version :: Fixed+ , numTables :: UShort+ , searchRange :: UShort+ , entrySelector :: UShort+ , rangeShift :: UShort , tableDirectories :: Map String TableDirectory- , os2 :: OS2- , head :: Head- , hhea :: Hhea- , name :: Name- , cmap :: Cmap- , maxp :: Maxp- , loca :: Loca- , hmtx :: Hmtx- , glyfs :: V.Vector Glyf- , kern :: Kern+ , os2 :: OS2+ , head :: Head+ , hhea :: Hhea+ , name :: Name+ , cmap :: Cmap+ , maxp :: Maxp+ , loca :: Loca+ , hmtx :: Hmtx+ , glyfs :: V.Vector Glyf+ , kern :: Kern } deriving (Show)
src/Utils.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+ module Utils( fromRight , substr@@ -8,15 +9,21 @@ , debug , formatTable , maxDuplicate+ , xattrRaw+ , xattr ) where -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import Control.Monad-import Debug.Trace-import Data.List-import Text.Printf-import Data.Function+import Blaze.ByteString.Builder.Char.Utf8+import Control.Monad+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Function+import Data.List+import Data.Text ()+import qualified Data.Text as T+import Debug.Trace+import Text.Printf+import qualified Text.XML.Generator as X fromRight :: (Either String t2, t) -> t2 fromRight (Right x, _) = x@@ -49,3 +56,9 @@ debug :: Monad m => String -> m () debug str = when True $ trace str $ return ()++xattrRaw :: String -> String -> X.Xml X.Attr+xattrRaw name attr = X.xattrQRaw X.defaultNamespace (T.pack name) (fromString attr)++xattr :: String -> T.Text -> X.Xml X.Attr+xattr name = X.xattr (T.pack name)
src/Webify.hs view
@@ -37,7 +37,7 @@ optsDef :: Parser Opts optsDef = Opts <$> switch (long "no-eot" <> help "Disable eot") <*> switch (long "no-woff" <> help "Disable woff")- <*> switch (long "no-svg" <> help "Disable eot")+ <*> switch (long "no-svg" <> help "Disable svg") <*> switch (long "svg-enable-kerning" <> help "Enable svg kerning") <*> switch (long "zopfli" <> help "Use Zopfli Compression Algorithm") <*> option (long "svg-cmap-platform-id" <> value platformMicrosoft <> help "Svg cmap platform id")@@ -121,7 +121,7 @@ displayError :: FilePath -> SomeException -> IO () displayError file e = (putStrLn $ "Failed to convert " ++ file) >> (putStrLn $ show e) -webifyVersion = "0.1.6.0"+webifyVersion = "0.1.7.0" main :: IO () main = do
webify.cabal view
@@ -1,5 +1,5 @@ name: webify-version: 0.1.6.0+version: 0.1.7.0 synopsis: webfont generator description: A command line tool to convert ttf file to woff, eot & svg files@@ -25,16 +25,17 @@ if flag(debug) ghc-prof-options: -prof, -fprof-auto - build-depends: base ==4.6.*,+ build-depends: base >=4.6 && <5, containers >= 0.4.2.1, bytestring >= 0.9,+ blaze-builder >= 0.3.3.4, binary >= 0.5.1,- binary-strict >= 0.4.8,+ binary-strict >= 0.4.8.2, text >= 0.7.2, filepath >= 1.3.0, zlib >= 0.5.4,- xmlgen == 0.4.0.3,- optparse-applicative >= 0.5.2,+ xmlgen >= 0.6.2.1,+ optparse-applicative >= 0.5.2 && <0.8.0, vector >= 0.10.0, hopfli >= 0.1.0.0