diff --git a/src/EOT.hs b/src/EOT.hs --- a/src/EOT.hs +++ b/src/EOT.hs @@ -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 diff --git a/src/Font.hs b/src/Font.hs --- a/src/Font.hs +++ b/src/Font.hs @@ -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 diff --git a/src/OTF.hs b/src/OTF.hs --- a/src/OTF.hs +++ b/src/OTF.hs @@ -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 diff --git a/src/SVG.hs b/src/SVG.hs --- a/src/SVG.hs +++ b/src/SVG.hs @@ -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] diff --git a/src/TTF.hs b/src/TTF.hs --- a/src/TTF.hs +++ b/src/TTF.hs @@ -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) diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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) diff --git a/src/Webify.hs b/src/Webify.hs --- a/src/Webify.hs +++ b/src/Webify.hs @@ -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 diff --git a/webify.cabal b/webify.cabal --- a/webify.cabal +++ b/webify.cabal @@ -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