SVG.hs

-- 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