packages feed

svgutils (empty) → 0.1

raw patch · 8 files changed

+745/−0 lines, 8 filesdep +basedep +filepathdep +xmlsetup-changed

Dependencies added: base, filepath, xml

Files

+ Data/SVG/Internal/Fail.hs view
@@ -0,0 +1,31 @@+module Data.SVG.Internal.Fail where++import Control.Applicative+import Control.Monad+import Data.Maybe (listToMaybe)++data FailM a = Fail String | OK a++instance Functor FailM where+  fmap _ (Fail x) = Fail x+  fmap f (OK x) = OK (f x)++instance Monad FailM where+  return = OK+  fail = Fail+  (>>=) (Fail x) _ = Fail x+  (>>=) (OK x) f = f x++instance Applicative FailM where+  (<*>) = ap+  pure = return++runFail :: FailM a -> Either String a+runFail (Fail x) = Left x+runFail (OK x) = Right x++maybeFail :: String -> Maybe a -> FailM a+maybeFail e = maybe (Fail e) OK++maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads
+ Data/SVG/Paper.hs view
@@ -0,0 +1,75 @@+-- SVGutils+-- Copyright (c) 2010, Neil Brown+--+-- 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 Neil Brown 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.++-- | A module with a helper function for dealing with paper sizes.+module Data.SVG.Paper (parsePaperSize) where++import Control.Applicative (liftA2)+import Data.Char (toLower)++import Data.SVG.SVG++-- | Parses a paper size which can either be a known name or a detailed size.+--+-- Paper sizes such as \"a4\" are not part of the SVG specification; this helper is provided here+-- in case you want help getting a paper size from a command-line argument.+--+-- This recognises two styles of paper size.  One is a literal name from the list+-- below, and the other is \"width*height\" (no spaces around the asterisk) where+-- width and height are valid SVG sizes that can be parsed by 'parseCoord' (using+-- a DPI of 90).  The+-- list of literal sizes, recognised case-insensitive (most of which are from the ISO 216 standard), is:+--+-- * \"a4\", \"a4portrait\": 210mm*297mm+--+-- * \"a4landscape\": 297mm*210mm+--+-- * \"a3\", \"a3portrait\": 297mm*420mm+--+-- * \"a3landscape\": 420mm*297mm+--+-- * \"letter\": 215.9mm*279.4mm+parsePaperSize :: String -> Maybe Size+parsePaperSize name = case map toLower name of+  "a4" -> s 210 297+  "a4portrait" -> s 210 297+  "a4landscape" -> s 297 210+  "a3" -> s 297 420+  "a3portrait" -> s 297 420+  "a3landscape" -> s 420 297+  "letter" -> s 215.9 279.4+  _ -> case span (/= '*') name of+         (w, '*':h) -> liftA2 Size (parseCoord dpi w) (parseCoord dpi h)+         _ -> Nothing+  where+    s w h = Just (Size w h)+    dpi = DPI 90
+ Data/SVG/SVG.hs view
@@ -0,0 +1,191 @@+-- SVGutils+-- Copyright (c) 2010, Neil Brown+--+-- 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 Neil Brown 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.++-- | A module containing all the basic types for dealing with SVG files.+module Data.SVG.SVG (MM(..), Size(..), DPI(..), SVG, getSVGElement, makeSVG, makeBlankSVG, parseSVG, getSVGSize, namespaces, parseCoord,+  placeAt) where++import Control.Applicative ((<$>), liftA2)+import Control.Arrow ((&&&))+import Control.Monad ((<=<))+import Data.List (find)+import Data.Maybe (fromJust)+import Data.SVG.Internal.Fail (maybeRead)+import Text.XML.Light+import Prelude hiding (elem)++-- | A wrapper around 'Double' for measurements in millimetres.+--+-- The 'Show' instance appends \"mm\" to the value.+newtype MM = MM Double+  deriving (Num, Ord, Eq, Fractional)++instance Show MM where+  show (MM mm) = show mm ++ "mm"++-- | A size (width and height) measured in millimetres.+data Size = Size { mmWidth :: MM, mmHeight :: MM }+  deriving (Show, Eq)++-- | A dots-per-inch measurement for dealing with graphics.+--+-- (To get dots per millimetre, divide by 25.4)+newtype DPI = DPI Double+  deriving (Num, Ord, Eq, Fractional)++instance Show DPI where+  show (DPI dpi) = show dpi+++-- | A container for SVG documents.  See the 'makeSVG' function for creating them,+-- and the 'getSVGElement' function for accessing them.+--+-- The 'Show' instance prints this as a complete XML document.+newtype SVG = SVG {+  -- | Gets the top-level \"svg\" element.+  getSVGElement ::  Element }++instance Show SVG where+  show = showTopElement . getSVGElement++-- | Creates an 'SVG' item from an XML element.+--+-- If the element is named \"svg\", this function will return a 'Just' result.+-- If the element is named anything else, this function will return 'Nothing'.+makeSVG :: Element -> Maybe SVG+makeSVG topLevelElement+  | qName (elName topLevelElement) == "svg" = Just $ SVG topLevelElement+  | otherwise = Nothing++-- | Parses a 'String' containing a complete XML document into an SVG.+--+-- This function can fail in two ways: it will fail either if the 'String' is not+-- a complete valid XML document, or if the top-level element is not an \"svg\"+-- element.+parseSVG :: String -> Maybe SVG+parseSVG = makeSVG <=< parseXMLDoc++{-+-- | Removes all the \"id\" fields from every element in the document.+stripSVG_id :: SVG -> SVG+stripSVG_id = SVG . stripElem_id . getSVGElement+  where+    stripElem_id e = e { elAttribs = stripAttr_id (elAttribs e), elContent = map stripContent_id (elContent e) }++    stripAttr_id = filter ((/= "id") . qName . attrKey)++    stripContent_id (Elem elem) = Elem (stripElem_id elem)+    stripContent_id x = x+-}++-- | Gets the size of the SVG document.+--+-- In an ideal world, this size would be some measurement in centimetres, etc. that+-- would be trivial to convert to millimetres.+--+-- Unfortunately, some programs (most notably Inkscape) record the document size+-- in pixels, which is very unhelpful when trying to get the size of the document+-- for printing, etc.  Therefore you must supply a 'DPI' parameter for converting+-- this pixel size into millimetres.  On my system, Inkscape uses a DPI of 90 but+-- I am not sure if this is system-specific or a constant that is used on all machines.+--+-- The method will fail if either the width or height attributes are missing at+-- the top-level, or they cannot be parsed using 'parseCoord'.+getSVGSize :: DPI -> SVG -> Maybe Size+getSVGSize dpi (SVG elem)+  = liftA2 Size (elem ! "width" >>= parseCoord dpi) (elem ! "height" >>= parseCoord dpi)+  where+    e ! a = attrVal <$> find ((== a) . qName . attrKey) (elAttribs e)++-- | Parses a coordinate\/length value from an SVG file.+--+-- All valid units are supported, except \"em\" and \"ex\" which depend on the size+-- of the current font.+--+-- The 'DPI' parameter is needed in order to convert user coordinate units (pixels) to millimetres.+--+-- This method assumes that no transformation is currently in place on the size.+--  It is primarily intended for parsing the size of the document, where there+-- can be no transformations present.+parseCoord :: DPI -> String -> Maybe MM+parseCoord (DPI dpi) s = MM <$> case splitUnits s of+  (n, "cm") -> (* 10) <$> maybeRead n+  (n, "in") -> (/ inchPerMM) <$> maybeRead n +  (n, "mm") -> maybeRead n+  (n, "px") -> processUser n+  (n, "pc") -> (/ (inchPerMM / 6)) <$> maybeRead n+  (n, "pt") -> (/ (inchPerMM / 72)) <$> maybeRead n+  _ -> processUser s+  where+    inchPerMM = 25.4+    processUser u = (/ (dpi / inchPerMM)) <$> maybeRead u++splitUnits :: String -> (String, String)+splitUnits s+  | length s <= 2 = (s, "")+  | otherwise = splitAt (length s - 2) s++-- | Places the given XML content (which is assumed to be a valid SVG fragment)+-- at the given (x, y) coordinates by wrapping them in an appropriate SVG transformation+-- (\<g\> element with transform attribute).+--+-- Note that if you place the resulting element inside a transformation, that transformation+-- will of course apply to this element as is standard in SVG.  So if you place+-- something at (20, 20) then wrap that in a scale transformation with factor 0.1,+-- it will end up placed at (2, 2).+placeAt :: DPI -> (MM, MM) -> [Content] -> Element+placeAt (DPI dpi) (MM mmx, MM mmy) content+  = Element (unqual "g") [Attr (unqual "transform") tranText] content Nothing+  where+    tranText = "translate(" ++ show (mmx * dpmm) ++ "," ++ show (mmy * dpmm) ++ ")"+    dpmm = dpi / 25.4++-- | Gets all the namespaces from the header of the SVG file.+namespaces :: SVG -> [(QName, String)]+namespaces = filter (isNamespace . fst) . map (attrKey &&& attrVal) . elAttribs . getSVGElement+  where+    isNamespace :: QName -> Bool+    isNamespace n+      | qName n == "xmlns" && qPrefix n == Nothing = True+      | qPrefix n == Just "xmlns" = True+      | otherwise = False++-- | Makes a blank SVG file of the given size.+makeBlankSVG :: Size -> SVG+makeBlankSVG (Size pw ph)+   = fromJust . makeSVG $ Element (unqual "svg")+        [unqual "version" ~> "1.0"+        ,unqual "width" ~> show pw+        ,unqual "height" ~> show ph+        ] [] Nothing+  where+    a ~> b = Attr a b
+ Data/SVG/Tile.hs view
@@ -0,0 +1,209 @@+-- SVGutils+-- Copyright (c) 2010, Neil Brown+--+-- 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 Neil Brown 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.++-- | A module with a helper function for tiling several SVG files (which can vary+-- in size) into a group of SVG files of a specific size.+module Data.SVG.Tile (TileItem(..), tileSVGs, TileSettings(..)) where++import Control.Applicative ((<$>))+import Control.Arrow ((***), (&&&))+import Control.Monad (liftM)+import Data.Function (on)+import Data.List (groupBy, nub, sortBy)+import Data.Maybe (fromJust, fromMaybe)+import Data.Ord (comparing)+import Data.SVG.SVG+import Data.SVG.Internal.Fail+import Text.XML.Light (unqual, Element(..), Content(..), Attr(..), QName(..))++-- | The settings for tiling: the paper size, margin (same on all sides) and gap (between tiled items)+data TileSettings = TileSettings+    { tilePaperSize :: Size+    , tileMargin :: MM+    , tileGap :: MM+    , ignoreNamespaceConflicts :: Bool+    }+    deriving (Show, Eq)++-- | An item to be tiled, with an SVG image for the front, and an optional SVG+-- for the back.  If the two images are different sizes, the smallest size that+-- can accommodate both is used for tiling.  This means that if you have a larger+-- back image, the front will have enough space left to match up with the back+-- (and vice versa).+--+-- The label is currently only used for error reporting.+data TileItem = TileItem { tileLabel :: String, tileFront :: SVG, tileBack :: Maybe SVG }++sizeAfterMargin :: TileSettings -> Size+sizeAfterMargin (TileSettings (Size pw ph) m _ _)+  = Size (pw - m - m) (ph - m - m)++data RowInfo = RowInfo {_curX :: MM, _curY :: MM, _rowHeight :: MM }++getTileSize :: DPI -> TileItem -> FailM Size+getTileSize dpi t+  = do frontSize <- maybeFail "SVG file has no size" $ getSVGSize dpi (tileFront t)+       case tileBack t of+         Nothing -> return frontSize+         Just back -> do backSize <- maybeFail "SVG file has no size" $ getSVGSize dpi back+                         return (frontSize `maxSize` backSize)++-- Smallest size that can fit both+maxSize :: Size -> Size -> Size+maxSize (Size w h) (Size w' h') = Size (w `max` w') (h `max` h')++type Tiled = ([(QName, String)], [Content])++-- | Tiles the given items.+--+-- This function takes a list of front (and optional back) SVG images, then arranges+-- them using the given paper size, margin and gaps between items.+-- The return is a list of front images (with back images where needed).+--+-- This method is intended to be used to put multiple small SVG items onto a single+-- page for printing.+--+-- The layout algorithm is very simple.  It places the first item in the top-left,+-- then attempts to fill the rest of the row with the next items in the list.+-- Once a row is full, it moves down to make more rows, until the page is full.+--  Thus, list items will always appear in the order they are given, and you can+-- potentially get some wasted space, especially if the items vary wildly in size,+-- and are not sorted by size first.+--+-- This method can fail because it cannot get the sizes of the items to tile+-- using 'getSVGSize', because there are conflicts between the namespaces of+-- the files, or because there are one or more items in the list that cannot+-- fit on a single page by themselves.+tileSVGs :: DPI -> TileSettings -> [TileItem] -> Either String [(SVG, Maybe SVG)]+tileSVGs dpi ts toTile = runFail $+  do sizes <- mapM (getTileSize dpi) toTile+     let make = uncurry $ makeTileSVG dpi ts+     tiles <- filter nonBlank <$> tileRow (RowInfo 0 0 0) (zip sizes toTile)+     mapM (liftM (make *** fmap make) . doAttrs) tiles+  where+    merge = mergeAttrs (ignoreNamespaceConflicts ts)+    +    doAttrs :: (Tiled, Maybe Tiled) -> FailM (([Attr], [Content]), Maybe ([Attr], [Content]))+    doAttrs (x, Nothing) = flip (,) Nothing <$> merge x+    doAttrs (x, Just y) = do x' <- merge x+                             y' <- merge y+                             return (x', Just y')+    +    tileRow :: RowInfo -> [(Size, TileItem)] -> FailM [(Tiled, Maybe Tiled)]+      -- We must return a blank page when there is nothing to place, due to the+      -- way that the rest of the algorithm works:+    tileRow _ [] = return [(([], []), Nothing)]+    tileRow ri (svg:svgs)+      = case placeAcross ri svg of+          Just (ri', el) -> do (es:ess) <- tileRow ri' svgs+                               -- We get the rest of the page (head of the list)+                               -- and add ourselves to that (and still include+                               -- all other pages)+                               return ((el *:* es) : ess)+          Nothing -> case placeAcross (RowInfo 0 0 0) svg of+                       Just (ri', el) ->+                         do (es:ess) <- tileRow ri' svgs+                            -- We put the end of the previous page (a blank)+                            -- before adding ourselves to the next page (head of+                            -- the list) and include all the other pages+                            return ((([], []), Nothing) : (el *:* es) : ess)+                       Nothing -> Fail $ tileLabel (snd svg) ++ " won't fit on a sheet"+      where+        (*:*) :: (([a], b), Maybe ([a], b)) -> (([a], [b]), Maybe ([a], [b]))+                                            -> (([a], [b]), Maybe ([a], [b]))+        (*:*) (x, my) (xs, mys) = (x & xs, maybe mys (Just . (& fromMaybe ([],[]) mys)) my)+          where+            (&) (as, b) (as', bs') = (as ++ as', b : bs')++    Size pw ph = sizeAfterMargin ts+    gap = tileGap ts+++    nonBlank (xs, mys) = not (nullTile xs) || maybe False (not . nullTile) mys+      where+        nullTile = null . snd+        +    -- Nothing if it won't fit on this sheet+    placeAcross :: RowInfo -> (Size, TileItem) ->+      Maybe (RowInfo, (([(QName, String)], Content), Maybe ([(QName, String)], Content)))+    placeAcross (RowInfo ox oy rh) (Size w h, t)+      | oy + h > ph -- Definitely too tall+         = Nothing+      -- So, not too tall:+      | ox + w <= pw -- Not too wide for this row; it fits+         = Just (RowInfo (ox + w + gap) oy (rh `max` h), placeFrontBack t w (ox, oy))+      -- Not too tall, but is too wide for this row; try next row:+      | (oy + rh + gap + h <= ph) && (w <= pw)+         -- Will fit on next row+         = Just (RowInfo (w + gap) (oy + rh + gap) h, placeFrontBack t w (0, oy + rh + gap))+      -- Didn't fit on next row either:+      | otherwise = Nothing++    placeFrontBack :: TileItem -> MM -> (MM, MM) ->+      (([(QName, String)], Content), Maybe ([(QName, String)], Content))+    placeFrontBack t w (x, y)+      = (namespaces &&& (Elem . placeAt dpi (x, y) . elContent . getSVGElement) $ tileFront t+        ,(namespaces &&& (Elem . placeAt dpi (flipHoriz w x, y) . elContent . getSVGElement)) <$> tileBack t+        )++    flipHoriz w x = pw - x - w++mergeAttrs :: Bool -> ([(QName, String)], a) -> FailM ([Attr], a)+mergeAttrs ignoreConflicts (attrs, x) = flip (,) x <$> mapM fromSingleton merged+  where+    merged :: [(QName, [String])]+    merged = map ((fst . head) &&& (nub . map snd)) $ groupBy ((==) `on` fst) $ sortBy (comparing fst) attrs++    fromSingleton :: (QName, [String]) -> FailM Attr+    fromSingleton (k, [v]) = return (Attr k v)+    fromSingleton (k, vs)+      | ignoreConflicts = return (Attr k (head vs))+      | otherwise = Fail $ concat+         ["Conflicting values for namespace "+         ,maybe "" (++ ":") (qPrefix k)+         ,qName k+         ,", values are: "+         ,show vs+         ]++makeTileSVG :: DPI -> TileSettings -> [Attr] -> [Content] -> SVG+makeTileSVG dpi (TileSettings (Size pw ph) margin _ _) attrs content +  = fromJust . makeSVG $ Element (unqual "svg") (attrs +++        [unqual "version" ~> "1.0"+        ,unqual "width" ~> show pw+        ,unqual "height" ~> show ph+        ])+        [Elem $ placeAt dpi (margin, margin) content]+        Nothing+  where+    a ~> b = Attr a b+
+ Data/SVG/TileMain.hs view
@@ -0,0 +1,160 @@+-- SVGutils+-- Copyright (c) 2010, Neil Brown+--+-- 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 Neil Brown 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.++import Control.Applicative ((<$>), (<*>))+import Control.Exception (IOException, try)+import Control.Monad (zipWithM_)+import Data.Either (lefts, rights)+import Data.List (minimumBy, sortBy)+import Data.Ord (comparing)+import Data.SVG.Internal.Fail+import Data.SVG.Paper+import Data.SVG.SVG+import Data.SVG.Tile+import System.Console.GetOpt+import System.Environment (getArgs)+import System.FilePath ((<.>), takeBaseName)+import System.IO (hPutStrLn, stderr)+import System.Exit (exitWith, ExitCode(..))++data Raw a b = Raw { r :: a }+data Processed a b = Processed { p :: b }++data Settings f = Settings+  { tryPaperRotate :: Bool+  , trySortingBySize :: Bool+  , help :: Bool+  , ignoreConflictingNamespaces :: Bool+  , dpi :: f String DPI+  , paperSize :: f String Size+  , margin :: f String MM+  , gap :: f String MM+  }++processSettings :: Settings Raw -> Either String (Settings Processed)+processSettings (Settings rt s h i d ps m g)+  = runFail $ do+      d' <- maybeFail ("Could not parse DPI: " ++ r d) (DPI <$> maybeRead (r d)) +      Settings rt s h i (Processed d')+       <$> proc ("Unknown paper size: " ++ r ps) (parsePaperSize (r ps))+       <*> proc ("Could not parse margin: " ++ r m) (parseCoord d' (r m))+       <*> proc ("Could not parse gap: " ++ r g) (parseCoord d' (r g))+  where+    proc u x = Processed <$> maybeFail u x++defaultSettings :: Settings Raw+defaultSettings = Settings False False False False (Raw "90") (Raw "a4") (Raw "20mm") (Raw "0mm")++options :: [OptDescr (Settings Raw -> Settings Raw)]+options =+ [Option "h" ["help"] (NoArg $ \s -> s {help = True}) "This help"+ ,Option "d" ["dpi"] (ReqArg (\d s -> s {dpi = Raw d}) "DPI")+   "Sets the DPI (Dots-Per-Inch) assumed; default is 90"+ ,Option "r" ["rotate"] (NoArg $ \s -> s {tryPaperRotate = True})+   "Try rotating the paper to see if less pages are needed"+ ,Option "s" ["sort"] (NoArg $ \s -> s {trySortingBySize = True})+   "Try sorting the items by height to see if less pages are needed"+ ,Option "z" ["size"] (ReqArg (\z s -> s {paperSize = Raw z}) "SIZE")+   "Paper size (e.g. \"a4\", \"letter\", \"10cm*10cm\"); default is a4"+ ,Option "m" ["margin"] (ReqArg (\m s -> s {margin = Raw m}) "MARGIN")+   "Margin (e.g. 3cm), default is 20mm"+ ,Option "g" ["gap"] (ReqArg (\g s -> s {gap = Raw g}) "GAP")+   "Gap between tiled items (e.g. 1cm), default is 0cm"+ ,Option "i" ["ignore-ns-conflicts"] (NoArg $ \s -> s {ignoreConflictingNamespaces = True})+   "Ignore conflicting namespaces in SVG files"+ ]++processArgs :: IO (Settings Processed, [String])+processArgs = do (fs, files, errs) <- getOpt Permute options <$> getArgs+                 if null errs+                   then let s = foldr (.) id fs $ defaultSettings+                        in if help s || null files+                             then do putStrLn $ usageInfo "SVGtile <file1.svg> <file2.svg> ... <fileN.svg>" options+                                     exitWith (if help s then ExitSuccess else ExitFailure 1)+                             else case processSettings s of+                               Left err -> quitWith err+                               Right s' -> return (s', files)+                   else quitWith (unlines errs)+                   +makeParams :: Settings Processed -> [(String, SVG, Maybe SVG)] -> [(TileSettings, [TileItem])]+makeParams s svgs+  = [ (TileSettings paper (p $ margin s) (p $ gap s) (ignoreConflictingNamespaces s), map (uncurry3 TileItem) items)+    | paper <- (p $ paperSize s) : [rotate (p $ paperSize s) | tryPaperRotate s]+    , items <- svgs : [map snd $ sortBy cmp svgsWithSize+                      | cmp <- [comparing height, flip (comparing height)]+                      , trySortingBySize s]+    ]+  where+    rotate (Size w h) = Size h w++    uncurry3 f (x, y, z) = f x y z++    svgsWithSize :: [(Maybe Size, (String, SVG, Maybe SVG))]+    svgsWithSize = [(getSVGSize (p $ dpi s) front, (l, front, back)) | (l, front, back) <- svgs]++    height :: (Maybe Size, a) -> Maybe MM+    height = fmap mmHeight . fst++output :: [(SVG, Maybe SVG)] -> IO ()+output = zipWithM_ write [1..]+  where+    write :: Int -> (SVG, Maybe SVG) -> IO ()+    write n (front, mback)+      = do writeFile ("TiledFront-" ++ show n ++ ".svg") (show front)+           case mback of+             Nothing -> return ()+             Just back -> writeFile ("TiledBack-" ++ show n ++ ".svg") (show back)++loadSVG :: FilePath -> IO (String, SVG, Maybe SVG)+loadSVG fullName+  = do mfront <- parseSVG <$> readFile fullName+       case mfront of+         Nothing -> quitWith ("Could not parse SVG file: " ++ fullName)+         Just front -> do mend <- either ioNothing parseSVG <$> try (readFile backName)+                          return (fullName, front, mend)+  where+    ioNothing :: IOException -> Maybe a+    ioNothing _ = Nothing++    backName = (takeBaseName fullName ++ "-front") <.> "svg"++quitWith :: String -> IO a+quitWith msg = hPutStrLn stderr msg >> exitWith (ExitFailure 1)++main :: IO ()+main = do (s, fileNames) <- processArgs+          svgs <- mapM loadSVG fileNames+          let ps = makeParams s svgs+          let rs = map (uncurry $ tileSVGs (p $ dpi s)) ps+          case rights rs of+            [] -> quitWith $ head (lefts rs)+            rrs -> output $ minimumBy (comparing length) rrs
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Neil Brown++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 Neil Brown 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
+ svgutils.cabal view
@@ -0,0 +1,47 @@+Name:                svgutils+Version:             0.1++Synopsis:            Helper functions for dealing with SVG files++Description:         A library for performing simple manipulations with SVG+                     files, primarily tiling several SVG files together into a+                     single file (ready for printing).+                     .+                     As well as the exposed library modules, the package comes+                     with an executable called SVGtile that can perform this+                     SVG tiling from the command-line.  SVGtile takes a list+                     of SVG files as command-line arguments, then generates+                     lots of files of the form TiledFront-1.svg.  Paper-size+                     (default A4) and other settings can be set using+                     command-line options: see SVGtile --help.++License:             BSD3+License-file:        LICENSE+Author:              Neil Brown+Maintainer:          neil@twistedsquare.com+Homepage:            https://patch-tag.com/r/twistedsquare/svgutils/home++Copyright:           Copyright Neil Brown, 2010.++Category:            Graphics++Build-type:          Simple+Cabal-version:       >=1.6++Library+  Exposed-modules:     Data.SVG.Paper Data.SVG.SVG Data.SVG.Tile+  Other-modules:       Data.SVG.Internal.Fail+  +  Build-depends:       base >= 4 && < 5, xml==1.3.*++  Extensions:          GeneralizedNewtypeDeriving+  GHC-Options:         -Wall+  +Executable SVGtile+  Main-is:             Data/SVG/TileMain.hs++  Build-depends:       base >= 4 && < 5, xml==1.3.*, filepath==1.1.*++  Extensions:          GeneralizedNewtypeDeriving+  GHC-Options:         -Wall+