adobe-swatch-exchange (empty) → 0.1.0.0
raw patch · 6 files changed
+387/−0 lines, 6 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, data-binary-ieee754, language-css, pretty
Files
- Data/AdobeSwatchExchange.hs +271/−0
- Data/AdobeSwatchExchange/CSS.hs +32/−0
- LICENSE +31/−0
- Setup.hs +2/−0
- adobe-swatch-exchange.cabal +29/−0
- ase2css.hs +22/−0
+ Data/AdobeSwatchExchange.hs view
@@ -0,0 +1,271 @@+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}+module Data.AdobeSwatchExchange where++import Control.Applicative ((<$>))+import Control.Monad (replicateM)+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as C+import Data.Char (chr, ord)+import Data.Data (Data, Typeable)+import Data.Word (Word16)+import Data.Binary.IEEE754 (getFloat32be, putFloat32be)+import Numeric (showHex)+import Data.Binary (Binary(..))+import Data.Binary.Get ( Get, getByteString, getWord8, getWord16be, getWord32be, runGet )+import Data.Binary.Put ( Put, putByteString, putWord8, putWord16be, putWord32be, runPut )++{-+But to summarize, look for the following elements (in no particular order):+- header+- version+- "block count"+- blocks+- color group start+- color group end+- swatches+- "zero block"++- strings++For swatch "blocks"+- swatch header+- block length+- swatch name+- color space+- color component values (single-precision floats)+- swatch attributes++The only thing to really watch out for is that the count near the beginning is *not* the swatch count, but the number of "blocks" in the file, which also includes color group information.++File signature 4*char (ASEF)+Version 2*int8 (1.0)+Number of blocks 1*int16+Blocks+Block type (0xc001 ⇒ Group start, 0xc002 ⇒ Group end, 0x0001 ⇒ Color entry)+Block length 1*int16+Group/Color name 0-terminated string of length (int16) double-byte characters+Color model 4*char (CMYK, RGB, LAB or Gray)+Color values CMYK ⇒ 4*float16 / RGB & LAB ⇒ 3*float16 / Gray ⇒ 1*float16+Color type 1*int8 (0 ⇒ Global, 1 ⇒ Spot, 2 ⇒ Normal)++-}++data Color+ = CYMK Float Float Float Float+ | RGB Float Float Float+ | LAB Float Float Float+ | Gray Float+ deriving (Eq, Ord, Read, Show, Data, Typeable)++data ColorType+ = Global+ | Spot+ | Normal+ deriving (Eq, Ord, Read, Show, Data, Typeable)++data ColorEntry = ColorEntry+ { colorName :: String+ , color :: Color+ , colorType :: ColorType+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)++data ASEBlock+ = GroupStart { groupName :: String }+ | GroupEnd+ | CE ColorEntry+ deriving (Eq, Ord, Read, Show, Data, Typeable)++data AdobeSwatchExchange = AdobeSwatchExchange+ { version :: (Word16, Word16)+ , blocks :: [ASEBlock]+ }+ deriving (Eq, Ord, Read, Show, Data, Typeable)++getFileSig :: Get ()+getFileSig =+ do bs <- getByteString 4+ case bs of+ "ASEF" -> return ()+ _ -> fail $ "Invalid file signature: " ++ show bs++putFileSig :: Put+putFileSig = putByteString "ASEF"++getVersion :: Get (Word16, Word16)+getVersion =+ do maj <- getWord16be+ min <- getWord16be+ return (maj, min)++putVersion :: (Word16, Word16) -> Put+putVersion (maj, min) =+ do putWord16be maj+ putWord16be min++getBlock :: Get ASEBlock+getBlock =+ do blockType <- getWord16be+ case blockType of+ 0xc001 -> do bl <- getWord32be+ n <- getName+ return (GroupStart n)+ 0xc002 -> do bl <- getWord32be+ return GroupEnd+ 0x0001 -> CE <$> getColorEntry+ _ -> fail $ "Unknown block type: " ++ (showHex blockType "")++putBlock :: ASEBlock -> Put+putBlock (GroupStart groupName) =+ do putWord16be 0xc001+ putWord32be $ blName groupName+ putName groupName+putBlock GroupEnd =+ do putWord16be 0xc002+ putWord32be 0+putBlock (CE colorEntry) =+ do putWord16be 0x0001+ putColorEntry colorEntry++getName :: Get String+getName =+ do nameLength <- getWord16be+ doubleChars <- replicateM ((fromIntegral nameLength) - 1) getWord16be+ _ <- getWord16be+ return $ map (chr . fromIntegral) doubleChars++putName :: String -> Put+putName nm =+ do putWord16be $ (fromIntegral (length nm) + 1)+ mapM_ (putWord16be . fromIntegral . ord) nm+ putWord16be 0++blName :: (Integral a) => String -> a+blName nm =+ fromIntegral (2 + (length nm * 2) + 2)++getColor :: Get Color+getColor =+ do modelString <- map (chr . fromIntegral) <$> replicateM 4 getWord8+ case modelString of+ "CYMK" -> do c <- getFloat32be+ y <- getFloat32be+ m <- getFloat32be+ k <- getFloat32be+ return $ CYMK c y m k+ "RGB " -> do r <- getFloat32be+ g <- getFloat32be+ b <- getFloat32be+ return $ RGB r g b+ "LAB " -> do l <- getFloat32be+ a <- getFloat32be+ b <- getFloat32be+ return $ LAB l a b+ "Gray" -> do g <- getFloat32be+ return $ Gray g+ _ -> fail $ "Unknown color model: " ++ modelString++putColor :: Color -> Put+putColor (CYMK c y m k) =+ do mapM_ (putWord8 . fromIntegral . ord) "CYMK"+ putFloat32be c+ putFloat32be y+ putFloat32be m+ putFloat32be k+putColor (RGB r g b) =+ do mapM_ (putWord8 . fromIntegral . ord) "RGB "+ putFloat32be r+ putFloat32be g+ putFloat32be b+putColor (LAB l a b) =+ do mapM_ (putWord8 . fromIntegral . ord) "LAB "+ putFloat32be l+ putFloat32be a+ putFloat32be b+putColor (Gray g) =+ do mapM_ (putWord8 . fromIntegral . ord) "Gray"+ putFloat32be g++blColor :: (Integral a) => Color -> a+blColor (CYMK {}) = 20+blColor (RGB {}) = 16+blColor (LAB {}) = 16+blColor (Gray {}) = 8++getColorType :: Get ColorType+getColorType =+ do ct <- getWord16be+ case ct of+ 0 -> return Global+ 1 -> return Spot+ 2 -> return Normal+ _ -> fail $ "Unknown color type: " ++ show ct++putColorType :: ColorType -> Put+putColorType Global = putWord16be 0+putColorType Spot = putWord16be 1+putColorType Normal = putWord16be 2++instance Binary ColorType where+ put = putColorType+ get = getColorType++blColorType :: (Integral a) => a+blColorType = fromIntegral 2++getColorEntry :: Get ColorEntry+getColorEntry =+ do bl <- getWord32be+ nm <- getName+ color <- getColor+ typ <- getColorType+ return $ ColorEntry { colorName = nm+ , color = color+ , colorType = typ+ }++putColorEntry :: ColorEntry -> Put+putColorEntry (ColorEntry cn c ct) =+ do putWord32be (blName cn + blColor c + blColorType)+ putName cn+ putColor c+ putColorType ct++instance Binary ColorEntry where+ put = putColorEntry+ get = getColorEntry++getASE :: Get AdobeSwatchExchange+getASE =+ do getFileSig+ v <- getVersion+ numBlocks <- getWord32be+ bs <- replicateM (fromIntegral numBlocks) getBlock -- unsafe-ish if there are billions of blocks+ return $ AdobeSwatchExchange { version = v+ , blocks = bs+ }++putASE :: AdobeSwatchExchange -> Put+putASE (AdobeSwatchExchange v blks) =+ do putFileSig+ putVersion v+ putWord32be (fromIntegral $ length blks)+ mapM_ putBlock blks++instance Binary AdobeSwatchExchange where+ put = putASE+ get = getASE++test =+ do c <- B.readFile "Yellow rose.ase"+ print $ runGet getASE c+ return ()++test_2 =+ do c <- B.readFile "Yellow rose.ase"+ print c+ let ase = runGet getASE c+ print ase+ let c' = runPut (put ase)+ print c'+ print (c == c')
+ Data/AdobeSwatchExchange/CSS.hs view
@@ -0,0 +1,32 @@+module Data.AdobeSwatchExchange.CSS where++import Data.AdobeSwatchExchange as ASE (ASEBlock(CE), ColorEntry(color), AdobeSwatchExchange, Color(RGB), blocks, getASE)+import qualified Data.ByteString.Lazy as B+import Language.Css.Build ((<:>), (/.), cword, ruleSets, star)+import Language.Css.Build.Idents as CSS (backgroundColor, color)+import Language.Css.Syntax (Expr, RuleSet, StyleSheet)+import Numeric (showHex)++ase2css :: [ColorEntry] -> StyleSheet+ase2css colorEntries =+ ruleSets (concatMap genColor (zip [1..] colorEntries))++genColor :: (Int, ColorEntry) -> [RuleSet]+genColor (n, colorEntry) =+ [ (star /. ("fg-color-ase-" ++ Prelude.show n)) [ CSS.color <:> (colorToHex (ASE.color colorEntry))+ ]+ , (star /. ("bg-color-ase-" ++ Prelude.show n)) [ backgroundColor <:> (colorToHex (ASE.color colorEntry))+ ]+ ]++colorToHex :: Color -> Expr+colorToHex (RGB r g b) =+ cword $+ showString "#" .+ showHex' (round (r * 255)) .+ showHex' (round (g * 255)) .+ showHex' (round (b * 255)) $ ""+ where+ showHex' n+ | n < 10 = showString "0" . showHex n+ | otherwise = showHex n
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2013, Jeremy Shaw, SeeReason Partners, LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jeremy Shaw, SeeReason Partners, LLC, nor+ the names of other contributors may be used to endorse or+ promote products derived from this software without specific+ prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ adobe-swatch-exchange.cabal view
@@ -0,0 +1,29 @@+name: adobe-swatch-exchange+version: 0.1.0.0+synopsis: parse Adobe Swatch Exchange files and (optionally) output .css files with the colors+homepage: https://github.com/stepcut/ase2css+license: BSD3+license-file: LICENSE+author: Jeremy Shaw+maintainer: jeremy@n-heptane.com+category: Web+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules: Data.AdobeSwatchExchange+ Data.AdobeSwatchExchange.CSS+ build-depends: base >= 4.5 && < 5,+ bytestring == 0.10.*,+ data-binary-ieee754 == 0.4.*,+ binary == 0.5.*,+ language-css == 0.0.*+executable ase2css+ main-is: ase2css.hs+ build-depends: base >= 4.5 && < 5,+ binary == 0.5.*,+ bytestring == 0.10.*,+ data-binary-ieee754 == 0.4.*,+ language-css == 0.0.*,+ pretty == 1.1.*+
+ ase2css.hs view
@@ -0,0 +1,22 @@+module Main where++import Data.AdobeSwatchExchange.CSS (ase2css)+import Data.AdobeSwatchExchange (ASEBlock(CE), ColorEntry(colorName), AdobeSwatchExchange, blocks, getASE)+import qualified Data.ByteString.Lazy as B+import Data.Binary.Get (runGet)+import Language.Css.Pretty (pretty)+import System.Environment (getArgs)+import Text.PrettyPrint.HughesPJ (($+$), (<+>), doubleQuotes, text)++main :: IO ()+main =+ do args <- getArgs+ case args of+ [inFile, outFile] ->+ do c <- B.readFile inFile+ let ase = runGet getASE c+ css = text "/* Generated from" <+> doubleQuotes (text inFile) <+> text "using ase2css */" $+$+ pretty (ase2css [ ce | (CE ce) <- blocks ase ])+ writeFile outFile $ show $ css+ _ -> putStrLn "Usage: ase2css <infile.ase> <outfile.css>"+