diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Jeffrey Rosenbluth + +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 Jeffrey Rosenbluth 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,64 @@ +svg-builder [![Hackage](https://img.shields.io/hackage/v/svg-builder.svg?style=flat)](https://hackage.haskell.org/package/svg-builder) +========= +Simple DSL for writing fast SVG. + +## Example + +``` haskell +{-# LANGUAGE OverloadedStrings #-} + +import Graphics.Svg + +svg :: Element -> Element +svg content = + doctype + <> with (svg11_ content) [Version_ <<- "1.1", Width_ <<- "300", Height_ <<- "200"] + +contents :: Element +contents = + rect_ [ Width_ <<- "100%", Height_ <<- "100%", "red" ->> Fill_] + <> circle_ [ Cx_ <<- "150", Cy_ <<- "100", R_ <<- "80", Fill_ <<- "green"] + <> text_ [ X_ <<- "150", Y_ <<- "125", Font_size_ <<- "60" + , Text_anchor_ <<- "middle", Fill_ <<- "white"] "SVG" + +main :: IO () +main = do + print $ svg contents +``` + +![SVG](http://i.imgur.com/dXu84xR.png) + +## Haskell logo + +``` haskell +{-# LANGUAGE OverloadedStrings #-} + +import Graphics.Svg + +svg :: Element -> Element +svg content = + doctype + <> with (svg11_ content) [Version_ <<- "1.1", Width_ <<- "482", Height_ <<- "340"] + +logo :: Element +logo = + path_ [ Fill_ <<- "#352950" + , D_ <<- ( mA 0 340 <> lA 113 170 <> lA 0 0 <> lA 85 0 + <> lA 198 170 <> lA 85 340 <> lA 0 340 <> z <> mA 0 340 ) ] + <> path_ [ Fill_ <<- "#4A3A74" + , D_ <<- ( mA 113 340 <> lA 226 170 <> lA 113 0 <> lA 198 0 + <> lA 425 340 <> lA 340 340 <> lA 269 234 <> lA 198 340 + <> lA 113 340 <> z <> mA 113 340 ) ] + <> path_ [ Fill_ <<- "#7C3679" + , D_ <<- ( mA 387 241 <> lA 350 184 <> lA 482 184 <> lA 482 241 + <> lA 387 241 <> z <> mA 387 241 ) ] + <> path_ [ Fill_ <<- "#7C3679" + , D_ <<- ( mA 331 156 <> lA 293 99 <> lA 482 99 <> lA 482 156 + <> lA 331 156 <> z <> mA 331 156 ) ] + +main :: IO () +main = do + print $ svg logo +``` + +![Logo](http://i.imgur.com/tuFExZl.png) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Graphics/Svg.hs b/src/Graphics/Svg.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Svg.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS -fno-warn-unused-imports #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Svg +-- Copyright : (c) 2015 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- DSL for creating SVG. +-- +------------------------------------------------------------------------------- +module Graphics.Svg + ( -- * Intro + -- $intro + -- * Re-exports + module Graphics.Svg.Core + , module Graphics.Svg.Path + , module Graphics.Svg.Elements + , module Graphics.Svg.Attributes + , (<>) + -- * Rendering + , prettyText + ) where + +import Data.Functor.Identity +import Data.Int (Int64) +import Data.Monoid +import Data.Text.Lazy as LT +import Data.Text.Lazy.Builder as B +import Graphics.Svg.Core +import Graphics.Svg.Attributes +import Graphics.Svg.Elements +import Graphics.Svg.Path + +prettyText :: Element -> Text +prettyText svg = B.toLazyText $ LT.foldr go mempty text Nothing (-1) + where + text = renderText svg + go c f Nothing n + | c == '<' || c == '/' = f (Just c) n + go c f (Just '<') n + | c == '?' = " f Nothing n + | c == '!' = " f Nothing n + | c == '/' = "\n" + <> (B.fromLazyText $ LT.replicate n " " ) + <> " f Nothing (n-1) + | otherwise = "\n" + <> (B.fromLazyText $ LT.replicate (n+1) " " ) + <> "<" + <> B.singleton c + <> f Nothing (n+1) + go '>' f (Just _) n = "/>" <> f Nothing (n-1) + go c f s n = s' <> B.singleton c <> f Nothing n + where s' = maybe mempty B.singleton s + +-- $intro +-- +-- SVG elements in Graphics-Svg are written with a postfix ‘@_@’. +-- Some examples: +-- +-- 'path_', 'circle_', 'color_', 'scale_' +-- +-- Plain text is written using the @OverloadedStrings@ +-- extension, and is automatically escaped: +-- +-- As in Graphics, elements nest by function application (unlike Graphics, there +-- is no Monad instance for 'Element's and an 'Attribute' list is always required): +-- +-- >>> g_ [] (text_ [] "Hello SVG") +-- Hello SVG +-- +-- and elements are juxtaposed via monoidal append: +-- +-- >>> text_ [] "Hello" <> text_ [] "SVG" +-- HelloSVG +-- +-- Attributes are set by providing an argument list. Each argument is set +-- using the 'bindAttr' function or operators, '<<-' and '->>'. +-- +-- >>> rect_ [Width_ <<- "100%", Height_ <<- "100%", "red" ->> Fill_] +-- +-- +-- Path data can be constructed using the functions in 'Graphics.Svg.Path' +-- and combined monoidally: +-- +-- @ +-- path_ +-- [ D_ <<- (mA 10 80 <> qA 52.5 10 95 80 <> tA 180 80 <> z) +-- , Stroke_ <<- "blue" +-- , Fill_ <<- "orange" +-- ] +-- @ +-- > +-- +-- __A slightly longer example__ +-- +-- > import Graphics.Svg +-- > +-- > svg :: Element -> Element +-- > svg content = +-- > doctype +-- > <> with (svg11_ content) [Version_ <<- "1.1", Width_ <<- "300" , Height_ <<- "200"] +-- > +-- > contents :: Element +-- > contents = +-- > rect_ [Width_ <<- "100%", Height_ <<- "100%", Fill_ <<- "red"] +-- > <> circle_ [Cx_ <<- "150", Cy_ <<- "100", R_ <<- "80", Fill_ <<- "green"] +-- > <> text_ [ X_ <<- "150", Y_ <<- "125", FontSize_ <<- "60" +-- > , TextAnchor_ <<- "middle", Fill_ <<- "white" ] "SVG" +-- > +-- > +-- > main :: IO () +-- > main = do +-- > print $ svg contents +-- <> +-- +-- __The haskell logo__ +-- +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > import Graphics.Svg +-- > +-- > svg :: Element -> Element +-- > svg content = +-- > doctype +-- > <> with (svg11_ content) [Version_ <<- "1.1", Width_ <<- "482", Height_ <<- "340"] +-- > +-- > logo :: Element +-- > logo = +-- > path_ [ Fill_ <<- "#352950" +-- > , D_ <<- ( mA 0 340 <> lA 113 170 <> lA 0 0 <> lA 85 0 +-- > <> lA 198 170 <> lA 85 340 <> lA 0 340 <> z <> mA 0 340 ) ] +-- > <> path_ [ Fill_ <<- "#4A3A74" +-- > , D_ <<- ( mA 113 340 <> lA 226 170 <> lA 113 0 <> lA 198 0 +-- > <> lA 425 340 <> lA 340 340 <> lA 269 234 <> lA 198 340 +-- > <> lA 113 340 <> z <> mA 113 340 ) ] +-- > <> path_ [ Fill_ <<- "#7C3679" +-- > , D_ <<- ( mA 387 241 <> lA 350 184 <> lA 482 184 <> lA 482 241 +-- > <> lA 387 241 <> z <> mA 387 241 ) ] +-- > <> path_ [ Fill_ <<- "#7C3679" +-- > , D_ <<- ( mA 331 156 <> lA 293 99 <> lA 482 99 <> lA 482 156 +-- > <> lA 331 156 <> z <> mA 331 156 ) ] +-- > +-- > main :: IO () +-- > main = do +-- > print $ svg logo +-- <> diff --git a/src/Graphics/Svg/Attributes.hs b/src/Graphics/Svg/Attributes.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Svg/Attributes.hs @@ -0,0 +1,577 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Svg.Attributes +-- Copyright : (c) 2015 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- SVG Attributes. +-- +------------------------------------------------------------------------------- + +module Graphics.Svg.Attributes + ( (<<-) + , (->>) + , bindAttr + , AttrTag(..) + ) where + +import Graphics.Svg.Core +import Data.Text (Text) + +-- | Make an 'Attribute' from it's value constructor and it's text value. +-- by combining an 'AttrTag' with it's value. +-- +-- > [bindAttr Width "100%, bindAttr Height "100%", bindAttr Fill "red"] +bindAttr :: AttrTag -> Text -> Attribute +bindAttr t v = makeAttribute (tag2text t) v + +-- | Infix version of 'bindAttr' +-- Each argument is set using '<<-', the 'bindAttr' function or '->>'. +-- +-- > [Width_ <<- "100%", Height_ <<- "100%", Fill_ <<- "red"] +infix 4 <<- +(<<-) :: AttrTag -> Text -> Attribute +(<<-) = bindAttr + +-- | Infix version of 'bindAttr' with it's arguments reversed. +-- +-- > ["100%" ->> Width_, "100%" ->> Height_, "red" ->> Fill_] +infix 4 ->> +(->>) :: Text -> AttrTag -> Attribute +(->>) = flip bindAttr + +data AttrTag + = Accent_height_ + | Accumulate_ + | Additive_ + | Alignment_baseline_ + | Alphabetic_ + | Amplitude_ + | Arabic_form_ + | Ascent_ + | AttributeName_ + | AttributeType_ + | Azimuth_ + | BaseFrequency_ + | Baseprofile_ + | Baseline_shift_ + | Bbox_ + | Begin_ + | Bias_ + | By_ + | CalcMode_ + | Cap_height_ + | Class_ + | Clip_ + | Clip_path_ + | Clip_rule_ + | ClipPathUnits_ + | Color_ + | Color_interpolation_ + | Color_interpolation_filters_ + | Color_profile_ + | Color_rendering_ + | ContentScriptType_ + | ContentStyleType_ + | Cursor_ + | Cx_ + | Cy_ + | D_ + | Descent_ + | DiffuseConstant_ + | Direction_ + | Display_ + | Divisor_ + | Dominant_baseline_ + | Dur_ + | Dx_ + | Dy_ + | EdgeMode_ + | Elevation_ + | Enable_background_ + | End_ + | Exponent_ + | ExternalResourcesRequired_ + | Fill_ + | Fill_opacity_ + | Fill_rule_ + | Filter_ + | FilterRes_ + | FilterUnits_ + | Flood_color_ + | Flood_opacity_ + | Font_family_ + | Font_size_ + | Font_size_adjust_ + | Font_stretch_ + | Font_style_ + | Font_variant_ + | Font_weight_ + | Format_ + | From_ + | Fx_ + | Fy_ + | G1_ + | G2_ + | Glyph_name_ + | Glyph_orientation_horizontal_ + | Glyph_orientation_vertical_ + | GradientTransform_ + | GradientUnits_ + | Hanging_ + | Height_ + | Horiz_adv_x_ + | Horiz_origin_x_ + | Horiz_origin_y_ + | Id_ + | Ideographic_ + | Image_rendering_ + | In_ + | In2_ + | Intercept_ + | K_ + | K1_ + | K2_ + | K3_ + | K4_ + | KernelMatrix_ + | KernelUnitLength_ + | Kerning_ + | KeyPoints_ + | KeySplines_ + | KeyTimes_ + | Lang_ + | LengthAdjust_ + | Letter_spacing_ + | Lighting_color_ + | LimitingConeAngle_ + | Local_ + | Marker_end_ + | Marker_mid_ + | Marker_start_ + | MarkerHeight_ + | MarkerUnits_ + | MarkerWidth_ + | MaskContentUnits_ + | MaskUnits_ + | Mathematical_ + | Max_ + | Media_ + | Method_ + | Min_ + | Mode_ + | Name_ + | NumOctaves_ + | Offset_ + | Onabort_ + | Onactivate_ + | Onbegin_ + | Onclick_ + | Onend_ + | Onerror_ + | Onfocusin_ + | Onfocusout_ + | Onload_ + | Onmousedown_ + | Onmousemove_ + | Onmouseout_ + | Onmouseover_ + | Onmouseup_ + | Onrepeat_ + | Onresize_ + | Onscroll_ + | Onunload_ + | Onzoom_ + | Opacity_ + | Operator_ + | Order_ + | Orient_ + | Orientation_ + | Origin_ + | Overflow_ + | Overline_position_ + | Overline_thickness_ + | Panose_1_ + | Paint_order_ + | Path_ + | PathLength_ + | PatternContentUnits_ + | PatternTransform_ + | PatternUnits_ + | Pointer_events_ + | Points_ + | PointsAtX_ + | PointsAtY_ + | PointsAtZ_ + | PreserveAlpha_ + | PreserveAspectRatio_ + | PrimitiveUnits_ + | R_ + | Radius_ + | RefX_ + | RefY_ + | Rendering_intent_ + | RepeatCount_ + | RepeatDur_ + | RequiredExtensions_ + | RequiredFeatures_ + | Restart_ + | Result_ + | Rotate_ + | Rx_ + | Ry_ + | Scale_ + | Seed_ + | Shape_rendering_ + | Slope_ + | Spacing_ + | SpecularConstant_ + | SpecularExponent_ + | SpreadMethod_ + | StartOffset_ + | StdDeviation_ + | Stemh_ + | Stemv_ + | StitchTiles_ + | Stop_color_ + | Stop_opacity_ + | Strikethrough_position_ + | Strikethrough_thickness_ + | String_ + | Stroke_ + | Stroke_dasharray_ + | Stroke_dashoffset_ + | Stroke_linecap_ + | Stroke_linejoin_ + | Stroke_miterlimit_ + | Stroke_opacity_ + | Stroke_width_ + | Style_ + | SurfaceScale_ + | SystemLanguage_ + | TableValues_ + | Target_ + | TargetX_ + | TargetY_ + | Text_anchor_ + | Text_decoration_ + | Text_rendering_ + | TextLength_ + | To_ + | Transform_ + | Type_ + | U1_ + | U2_ + | Underline_position_ + | Underline_thickness_ + | Unicode_ + | Unicode_bidi_ + | Unicode_range_ + | Units_per_em_ + | V_alphabetic_ + | V_hanging_ + | V_ideographic_ + | V_mathematical_ + | Values_ + | Version_ + | Vert_adv_y_ + | Vert_origin_x_ + | Vert_origin_y_ + | ViewBox_ + | ViewTarget_ + | Visibility_ + | Width_ + | Widths_ + | Word_spacing_ + | Writing_mode_ + | X_ + | X_height_ + | X1_ + | X2_ + | XChannelSelector_ + | XlinkActuate_ + | XlinkArcrole_ + | XlinkHref_ + | XlinkRole_ + | XlinkShow_ + | XlinkTitle_ + | XlinkType_ + | XmlBase_ + | XmlLang_ + | XmlSpace_ + | Y_ + | Y1_ + | Y2_ + | YChannelselector_ + | Z_ + | ZoomAndPan_ + +-- Link the tags to their svg strings. +tag2text :: AttrTag -> Text +tag2text Accent_height_ = "accent-height" +tag2text Accumulate_ = "accumulate" +tag2text Additive_ = "additive" +tag2text Alignment_baseline_ = "alignment-baseline" +tag2text Alphabetic_ = "alphabetic" +tag2text Amplitude_ = "amplitude" +tag2text Arabic_form_ = "arabic-form" +tag2text Ascent_ = "ascent" +tag2text AttributeName_ = "attributeName" +tag2text AttributeType_ = "attributeType" +tag2text Azimuth_ = "azimuth" +tag2text BaseFrequency_ = "baseFrequency" +tag2text Baseprofile_ = "baseprofile" +tag2text Baseline_shift_ = "baseline-shift" +tag2text Bbox_ = "bbox" +tag2text Begin_ = "begin" +tag2text Bias_ = "bias" +tag2text By_ = "by" +tag2text CalcMode_ = "calcMode" +tag2text Cap_height_ = "cap-height" +tag2text Class_ = "class" +tag2text Clip_ = "clip" +tag2text Clip_path_ = "clip-path" +tag2text Clip_rule_ = "clip-rule" +tag2text ClipPathUnits_ = "clipPathUnits" +tag2text Color_ = "color" +tag2text Color_interpolation_ = "color-interpolation" +tag2text Color_interpolation_filters_ = "color-interpolation-filters" +tag2text Color_profile_ = "color-profile" +tag2text Color_rendering_ = "color-rendering" +tag2text ContentScriptType_ = "contentScriptType" +tag2text ContentStyleType_ = "contentStyleType" +tag2text Cursor_ = "cursor" +tag2text Cx_ = "cx" +tag2text Cy_ = "cy" +tag2text D_ = "d" +tag2text Descent_ = "descent" +tag2text DiffuseConstant_ = "diffuseConstant" +tag2text Direction_ = "direction" +tag2text Display_ = "display" +tag2text Divisor_ = "divisor" +tag2text Dominant_baseline_ = "dominant-baseline" +tag2text Dur_ = "dur" +tag2text Dx_ = "dx" +tag2text Dy_ = "dy" +tag2text EdgeMode_ = "edgeMode" +tag2text Elevation_ = "elevation" +tag2text Enable_background_ = "enable-background" +tag2text End_ = "end" +tag2text Exponent_ = "exponent" +tag2text ExternalResourcesRequired_ = "externalResourcesRequired" +tag2text Fill_ = "fill" +tag2text Fill_opacity_ = "fill-opacity" +tag2text Fill_rule_ = "fill-rule" +tag2text Filter_ = "filter" +tag2text FilterRes_ = "filterRes" +tag2text FilterUnits_ = "filterUnits" +tag2text Flood_color_ = "flood-color" +tag2text Flood_opacity_ = "flood-opacity" +tag2text Font_family_ = "font-family" +tag2text Font_size_ = "font-size" +tag2text Font_size_adjust_ = "font-size-adjust" +tag2text Font_stretch_ = "font-stretch" +tag2text Font_style_ = "font-style" +tag2text Font_variant_ = "font-variant" +tag2text Font_weight_ = "font-weight" +tag2text Format_ = "format" +tag2text From_ = "from" +tag2text Fx_ = "fx" +tag2text Fy_ = "fy" +tag2text G1_ = "g1" +tag2text G2_ = "g2" +tag2text Glyph_name_ = "glyph-name" +tag2text Glyph_orientation_horizontal_ = "glyph-orientation-horizontal" +tag2text Glyph_orientation_vertical_ = "glyph-orientation-vertical" +tag2text GradientTransform_ = "gradientTransform" +tag2text GradientUnits_ = "gradientUnits" +tag2text Hanging_ = "hanging" +tag2text Height_ = "height" +tag2text Horiz_adv_x_ = "horiz-adv-x" +tag2text Horiz_origin_x_ = "horiz-origin-x" +tag2text Horiz_origin_y_ = "horiz-origin-y" +tag2text Id_ = "id" +tag2text Ideographic_ = "ideographic" +tag2text Image_rendering_ = "image-rendering" +tag2text In_ = "in" +tag2text In2_ = "in2" +tag2text Intercept_ = "intercept" +tag2text K_ = "k" +tag2text K1_ = "k1" +tag2text K2_ = "k2" +tag2text K3_ = "k3" +tag2text K4_ = "k4" +tag2text KernelMatrix_ = "kernelMatrix" +tag2text KernelUnitLength_ = "kernelUnitLength" +tag2text Kerning_ = "kerning" +tag2text KeyPoints_ = "keyPoints" +tag2text KeySplines_ = "keySplines" +tag2text KeyTimes_ = "keyTimes" +tag2text Lang_ = "lang" +tag2text LengthAdjust_ = "lengthAdjust" +tag2text Letter_spacing_ = "letter-spacing" +tag2text Lighting_color_ = "lighting-color" +tag2text LimitingConeAngle_ = "limitingConeAngle" +tag2text Local_ = "local" +tag2text Marker_end_ = "marker-end" +tag2text Marker_mid_ = "marker-mid" +tag2text Marker_start_ = "marker-start" +tag2text MarkerHeight_ = "markerHeight" +tag2text MarkerUnits_ = "markerUnits" +tag2text MarkerWidth_ = "markerWidth" +tag2text MaskContentUnits_ = "maskContentUnits" +tag2text MaskUnits_ = "maskUnits" +tag2text Mathematical_ = "mathematical" +tag2text Max_ = "max" +tag2text Media_ = "media" +tag2text Method_ = "method" +tag2text Min_ = "min" +tag2text Mode_ = "mode" +tag2text Name_ = "name" +tag2text NumOctaves_ = "numOctaves" +tag2text Offset_ = "offset" +tag2text Onabort_ = "onabort" +tag2text Onactivate_ = "onactivate" +tag2text Onbegin_ = "onbegin" +tag2text Onclick_ = "onclick" +tag2text Onend_ = "onend" +tag2text Onerror_ = "onerror" +tag2text Onfocusin_ = "onfocusin" +tag2text Onfocusout_ = "onfocusout" +tag2text Onload_ = "onload" +tag2text Onmousedown_ = "onmousedown" +tag2text Onmousemove_ = "onmousemove" +tag2text Onmouseout_ = "onmouseout" +tag2text Onmouseover_ = "onmouseover" +tag2text Onmouseup_ = "onmouseup" +tag2text Onrepeat_ = "onrepeat" +tag2text Onresize_ = "onresize" +tag2text Onscroll_ = "onscroll" +tag2text Onunload_ = "onunload" +tag2text Onzoom_ = "onzoom" +tag2text Opacity_ = "opacity" +tag2text Operator_ = "operator" +tag2text Order_ = "order" +tag2text Orient_ = "orient" +tag2text Orientation_ = "orientation" +tag2text Origin_ = "origin" +tag2text Overflow_ = "overflow" +tag2text Overline_position_ = "overline-position" +tag2text Overline_thickness_ = "overline-thickness" +tag2text Panose_1_ = "panose-1" +tag2text Paint_order_ = "paint-order" +tag2text Path_ = "path" +tag2text PathLength_ = "pathLength" +tag2text PatternContentUnits_ = "patternContentUnits" +tag2text PatternTransform_ = "patternTransform" +tag2text PatternUnits_ = "patternUnits" +tag2text Pointer_events_ = "pointer-events" +tag2text Points_ = "points" +tag2text PointsAtX_ = "pointsAtX" +tag2text PointsAtY_ = "pointsAtY" +tag2text PointsAtZ_ = "pointsAtZ" +tag2text PreserveAlpha_ = "preserveAlpha" +tag2text PreserveAspectRatio_ = "preserveAspectRatio" +tag2text PrimitiveUnits_ = "primitiveUnits" +tag2text R_ = "r" +tag2text Radius_ = "radius" +tag2text RefX_ = "refX" +tag2text RefY_ = "refY" +tag2text Rendering_intent_ = "rendering-intent" +tag2text RepeatCount_ = "repeatCount" +tag2text RepeatDur_ = "repeatDur" +tag2text RequiredExtensions_ = "requiredExtensions" +tag2text RequiredFeatures_ = "requiredFeatures" +tag2text Restart_ = "restart" +tag2text Result_ = "result" +tag2text Rotate_ = "rotate" +tag2text Rx_ = "rx" +tag2text Ry_ = "ry" +tag2text Scale_ = "scale" +tag2text Seed_ = "seed" +tag2text Shape_rendering_ = "shape-rendering" +tag2text Slope_ = "slope" +tag2text Spacing_ = "spacing" +tag2text SpecularConstant_ = "specularConstant" +tag2text SpecularExponent_ = "specularExponent" +tag2text SpreadMethod_ = "spreadMethod" +tag2text StartOffset_ = "startOffset" +tag2text StdDeviation_ = "stdDeviation" +tag2text Stemh_ = "stemh" +tag2text Stemv_ = "stemv" +tag2text StitchTiles_ = "stitchTiles" +tag2text Stop_color_ = "stop-color" +tag2text Stop_opacity_ = "stop-opacity" +tag2text Strikethrough_position_ = "strikethrough-position" +tag2text Strikethrough_thickness_ = "strikethrough-thickness" +tag2text String_ = "string" +tag2text Stroke_ = "stroke" +tag2text Stroke_dasharray_ = "stroke-dasharray" +tag2text Stroke_dashoffset_ = "stroke-dashoffset" +tag2text Stroke_linecap_ = "stroke-linecap" +tag2text Stroke_linejoin_ = "stroke-linejoin" +tag2text Stroke_miterlimit_ = "stroke-miterlimit" +tag2text Stroke_opacity_ = "stroke-opacity" +tag2text Stroke_width_ = "stroke-width" +tag2text Style_ = "style" +tag2text SurfaceScale_ = "surfaceScale" +tag2text SystemLanguage_ = "systemLanguage" +tag2text TableValues_ = "tableValues" +tag2text Target_ = "target" +tag2text TargetX_ = "targetX" +tag2text TargetY_ = "targetY" +tag2text Text_anchor_ = "text-anchor" +tag2text Text_decoration_ = "text-decoration" +tag2text Text_rendering_ = "text-rendering" +tag2text TextLength_ = "textLength" +tag2text To_ = "to" +tag2text Transform_ = "transform" +tag2text Type_ = "type" +tag2text U1_ = "u1" +tag2text U2_ = "u2" +tag2text Underline_position_ = "underline-position" +tag2text Underline_thickness_ = "underline-thickness" +tag2text Unicode_ = "unicode" +tag2text Unicode_bidi_ = "unicode-bidi" +tag2text Unicode_range_ = "unicode-range" +tag2text Units_per_em_ = "units-per-em" +tag2text V_alphabetic_ = "v-alphabetic" +tag2text V_hanging_ = "v-hanging" +tag2text V_ideographic_ = "v-ideographic" +tag2text V_mathematical_ = "v-mathematical" +tag2text Values_ = "values" +tag2text Version_ = "version" +tag2text Vert_adv_y_ = "vert-adv-y" +tag2text Vert_origin_x_ = "vert-origin-x" +tag2text Vert_origin_y_ = "vert-origin-y" +tag2text ViewBox_ = "viewBox" +tag2text ViewTarget_ = "viewTarget" +tag2text Visibility_ = "visibility" +tag2text Width_ = "width" +tag2text Widths_ = "widths" +tag2text Word_spacing_ = "word-spacing" +tag2text Writing_mode_ = "writing-mode" +tag2text X_ = "x" +tag2text X_height_ = "x-height" +tag2text X1_ = "x1" +tag2text X2_ = "x2" +tag2text XChannelSelector_ = "xChannelSelector" +tag2text XlinkActuate_ = "xlink:actuate" +tag2text XlinkArcrole_ = "xlink:arcrole" +tag2text XlinkHref_ = "xlink:href" +tag2text XlinkRole_ = "xlink:role" +tag2text XlinkShow_ = "xlink:show" +tag2text XlinkTitle_ = "xlink:title" +tag2text XlinkType_ = "xlink:type" +tag2text XmlBase_ = "xml:base" +tag2text XmlLang_ = "xml:lang" +tag2text XmlSpace_ = "xml:space" +tag2text Y_ = "y" +tag2text Y1_ = "y1" +tag2text Y2_ = "y2" +tag2text YChannelselector_ = "yChannelSelector" +tag2text Z_ = "z" +tag2text ZoomAndPan_ = "zoomAndPan" diff --git a/src/Graphics/Svg/Core.hs b/src/Graphics/Svg/Core.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Svg/Core.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +------------------------------------------------------------------------------- +-- | +-- Module : SVG.Core +-- Copyright : (c) 2015 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- svg-builder Core types and functions. +-- +------------------------------------------------------------------------------- + +module Graphics.Svg.Core +( -- * Types + Attribute +, Element +, ToElement(..) +, Term(..) + -- * Combinators +, makeAttribute +, makeElement +, makeElementNoEnd +, makeElementDoctype +, with + -- * Rendering +, renderBS +, renderToFile +, renderText +) where + +import Blaze.ByteString.Builder (Builder) +import qualified Blaze.ByteString.Builder as BB +import qualified Blaze.ByteString.Builder.Html.Utf8 as BB +import qualified Data.ByteString.Lazy as LB +import Data.ByteString.Lazy (ByteString) +import Data.Hashable (Hashable(..)) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as M +import Data.Monoid +import Data.String +import Data.Text (Text) +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT + +-------------------------------------------------------------------------------- +-- Types + +-- | Attribute name value. +data Attribute = Attribute !Text !Text + deriving (Show,Eq) + +instance Hashable Attribute where + hashWithSalt salt (Attribute a b) = salt `hashWithSalt` a `hashWithSalt` b + +-- | Type of an SVG element. +newtype Element = Element (HashMap Text Text -> Builder) + +instance Show Element where + show e = LT.unpack . renderText $ e + +instance Monoid Element where + mempty = Element mempty + mappend (Element e1) (Element e2) = Element (e1 <> e2) + +instance IsString Element where + fromString = toElement + +-- | Things that can be converted to SVG elements. +class ToElement a where + toElement :: a -> Element + +instance ToElement String where + toElement = Element . const . BB.fromHtmlEscapedString + +instance ToElement Text where + toElement = Element . const . BB.fromHtmlEscapedText + +instance ToElement LT.Text where + toElement = Element . const . BB.fromHtmlEscapedLazyText + +-- | Used to make specific SVG element builders. +class Term result where + -- | Used for constructing elements e.g. @term "circle"@ yields 'circle_'. + term :: Text -> [Attribute] -> result + +instance (e ~ Element) => Term (e -> Element) where + term name attrs e = with (makeElement name e) attrs + +instance Term Element where + term name attrs = with (makeElementNoEnd name) attrs + +-------------------------------------------------------------------------------- +-- Combinators + +-- | Make an attribute. +makeAttribute :: Text -- ^ Attribute name. + -> Text -- ^ Attribute value. + -> Attribute +makeAttribute = Attribute + +-- | Union two sets of attributes and append duplicate keys. +unionAttrs :: HashMap Text Text -> HashMap Text Text -> HashMap Text Text +unionAttrs = M.unionWith (<>) + +-- | Add a list of attributes to an element +with :: Element -> [Attribute] -> Element +with (Element e) attrs = Element $ \a -> + e (unionAttrs (M.fromListWith (<>) (map toPair attrs)) a) + where + toPair (Attribute x y) = (x,y) + +-- | Make an SVG element builder +makeElement :: Text -> Element -> Element +makeElement name (Element c) = Element $ \a -> go c a + where + go children attrs = + s2b "<" <> BB.fromText name + <> foldlMapWithKey buildAttr attrs <> s2b ">" + <> children mempty + <> s2b " BB.fromText name <> s2b ">" + +-- | Make an SVG doctype element builder. +makeElementDoctype :: Text -> Element +makeElementDoctype name = Element $ \a -> go a + where + go attrs = + s2b "<" <> BB.fromText name + <> foldlMapWithKey buildAttr attrs <> s2b ">" + +-- | Make an SVG element with no end tag, contains only attributes. +makeElementNoEnd :: Text -> Element +makeElementNoEnd name = Element $ \a -> go a + where + go attrs = + s2b "<" <> BB.fromText name + <> foldlMapWithKey buildAttr attrs <> s2b "/>" + +-- | Folding and monoidally appending attributes. +foldlMapWithKey :: Monoid m => (k -> v -> m) -> HashMap k v -> m +foldlMapWithKey f = M.foldlWithKey' (\m k v -> m <> f k v) mempty + +s2b :: String -> Builder +s2b = BB.fromString + +-- | Build and encode an attribute. +buildAttr :: Text -> Text -> Builder +buildAttr key val = + s2b " " <> + BB.fromText key <> + if val == mempty + then mempty + else s2b "=\"" <> BB.fromHtmlEscapedText val <> s2b "\"" + +-------------------------------------------------------------------------------- +-- Rendering + +-- | Render a 'Element' to lazy bytestring. +renderBS :: Element -> ByteString +renderBS (Element e) = BB.toLazyByteString $ e mempty + +-- | Render a 'Element' to a file. +renderToFile :: FilePath -> Element -> IO () +renderToFile fp = LB.writeFile fp . renderBS + +-- | Reder an 'Element' to lazy text. +renderText :: Element -> LT.Text +renderText = LT.decodeUtf8 . renderBS diff --git a/src/Graphics/Svg/Elements.hs b/src/Graphics/Svg/Elements.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Svg/Elements.hs @@ -0,0 +1,351 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Svg.Elements +-- Copyright : (c) 2015 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- SVG elements. +-- +------------------------------------------------------------------------------- + +module Graphics.Svg.Elements where + +import Graphics.Svg.Core + +-- | @DOCTYPE@ element +doctype :: Element +doctype = makeElementDoctype "?xml version=\"1.0\" encoding=\"UTF-8\"?>\n Element +svg11_ = svg_ [ makeAttribute "xmlns" "http://www.w3.org/2000/svg" + , makeAttribute "xmlns:xlink" "http://www.w3.org/1999/xlink" + , makeAttribute "version" "1.1" ] + +-- | @a@ element +a_ :: Term result => [Attribute] -> result +a_ = term "a" + +-- | @altglyph@ element +{-# DEPRECATED altGlyph_ "Removed from web standards." #-} +altGlyph_ :: Term result => [Attribute] -> result +altGlyph_ = term "altGlyph" + +-- | @altglyphdef@ element +{-# DEPRECATED altGlyphDef_ "Removed from web standards." #-} +altGlyphDef_ :: Term result => [Attribute] -> result +altGlyphDef_ = term "altGlyphDef" + +-- | @altglyphitem@ element +{-# DEPRECATED altGlyphItem_ "Removed from web standards." #-} +altGlyphItem_ :: Term result => [Attribute] -> result +altGlyphItem_ = term "altGlyphItem" + +-- | @animate@ element +animate_ :: Term result => [Attribute] -> result +animate_ = term "animate" + +-- | @animatecolor@ element +{-# DEPRECATED animateColor_ "Removed from web standards." #-} +animateColor_ :: Term result => [Attribute] -> result +animateColor_ = term "animateColor" + +-- | @animatemotion@ element +animateMotion_ :: Term result => [Attribute] -> result +animateMotion_ = term "animateMotion" + +-- | @animatetransform@ element +animateTransform_ :: Term result => [Attribute] -> result +animateTransform_ = term "animateTransform" + +-- | @circle@ element +circle_ :: Term result => [Attribute] -> result +circle_ = term "circle" + +-- | @clipPath@ element or attribute +clipPath_ :: Term result => [Attribute] -> result +clipPath_ = term "clipPath" + +-- | @colorProfile@ element +colorProfile_ :: Term result => [Attribute] -> result +colorProfile_ = term "color-profile" + +-- | @cursor@ element +cursor_ :: Term result => [Attribute] -> result +cursor_ = term "cursor" + +-- | @defs@ element +defs_ :: Term result => [Attribute] -> result +defs_ = term "defs" + +-- | @desc@ element +desc_ :: Term result => [Attribute] -> result +desc_ = term "desc" + +-- | @ellipse@ element +ellipse_ :: Term result => [Attribute] -> result +ellipse_ = term "ellipse" + +-- | @feblend@ element +feBlend_ :: Term result => [Attribute] -> result +feBlend_ = term "feBlend" + +-- | @fecolormatrix@ element +feColorMatrix_ :: Term result => [Attribute] -> result +feColorMatrix_ = term "feColorMatrix" + +-- | @fecomponenttransfer@ element +feComponentTransfer_ :: Term result => [Attribute] -> result +feComponentTransfer_ = term "feComponentTransfer" + +-- | @fecomposite@ element +feComposite_ :: Term result => [Attribute] -> result +feComposite_ = term "feComposite" + +-- | @feconvolvematrix@ element +feConvolveMatrix_ :: Term result => [Attribute] -> result +feConvolveMatrix_ = term "feConvolveMatrix" + +-- | @fediffuselighting@ element +feDiffuseLighting_ :: Term result => [Attribute] -> result +feDiffuseLighting_ = term "feDiffuseLighting" + +-- | @fedisplacementmap@ element +feDisplacementMap_ :: Term result => [Attribute] -> result +feDisplacementMap_ = term "feDisplacementMap" + +-- | @fedistantlight@ element +feDistantLight_ :: Term result => [Attribute] -> result +feDistantLight_ = term "feDistantLight" + +-- | @feflood@ element +feFlood_ :: Term result => [Attribute] -> result +feFlood_ = term "feFlood" + +-- | @fefunca@ element +feFuncA_ :: Term result => [Attribute] -> result +feFuncA_ = term "feFuncA" + +-- | @fefuncb@ element +feFuncB_ :: Term result => [Attribute] -> result +feFuncB_ = term "feFuncB" + +-- | @fefuncg@ element +feFuncG_ :: Term result => [Attribute] -> result +feFuncG_ = term "feFuncG" + +-- | @fefuncr@ element +feFuncR_ :: Term result => [Attribute] -> result +feFuncR_ = term "feFuncR" + +-- | @fegaussianblur@ element +feGaussianBlur_ :: Term result => [Attribute] -> result +feGaussianBlur_ = term "feGaussianBlur" + +-- | @feimage@ element +feImage_ :: Term result => [Attribute] -> result +feImage_ = term "feImage" + +-- | @femerge@ element +feMerge_ :: Term result => [Attribute] -> result +feMerge_ = term "feMerge" + +-- | @femergenode@ element +feMergeNode_ :: Term result => [Attribute] -> result +feMergeNode_ = term "feMergeNode" + +-- | @femorphology@ element +feMorphology_ :: Term result => [Attribute] -> result +feMorphology_ = term "feMorphology" + +-- | @feoffset@ element +feOffset_ :: Term result => [Attribute] -> result +feOffset_ = term "feOffset" + +-- | @fepointlight@ element +fePointLight_ :: Term result => [Attribute] -> result +fePointLight_ = term "fePointLight" + +-- | @fespecularlighting@ element +feSpecularLighting_ :: Term result => [Attribute] -> result +feSpecularLighting_ = term "feSpecularLighting" + +-- | @fespotlight@ element +feSpotLight_ :: Term result => [Attribute] -> result +feSpotLight_ = term "feSpotLight" + +-- | @fetile@ element +feTile_ :: Term result => [Attribute] -> result +feTile_ = term "feTile" + +-- | @feturbulence@ element +feTurbulence_ :: Term result => [Attribute] -> result +feTurbulence_ = term "feTurbulence" + +-- | @filter_@ element +filter_ :: Term result => [Attribute] -> result +filter_ = term "filter" + +-- | @font@ element +font_ :: Term result => [Attribute] -> result +font_ = term "font" + +-- | @fontFace@ element +fontFace_ :: Term result => [Attribute] -> result +fontFace_ = term "font-face" + +-- | @fontFaceFormat@ element +fontFaceFormat_ :: [Attribute] -> Element +fontFaceFormat_ = with $ makeElementNoEnd "font-face-format" + +-- | @fontFaceName@ element +fontFaceName_ :: [Attribute] -> Element +fontFaceName_ = with $ makeElementNoEnd "font-face-name" + +-- | @fontFaceSrc@ element +fontFaceSrc_ :: Term result => [Attribute] -> result +fontFaceSrc_ = term "font-face-src" + +-- | @fontFaceUri@ element +fontFaceUri_ :: Term result => [Attribute] -> result +fontFaceUri_ = term "font-face-uri" + +-- | @foreignobject@ element +foreignObject_ :: Term result => [Attribute] -> result +foreignObject_ = term "foreignObject" + +-- | @g@ element +g_ :: Term result => [Attribute] -> result +g_ = term "g" + +-- | @glyph@ element or attribute +glyph_ :: Term result => [Attribute] -> result +glyph_ = term "glyph" + +-- | @glyphref@ element +glyphRef_ :: [Attribute] -> Element +glyphRef_ = with $ makeElementNoEnd "glyphRef" + +-- | @hkern@ element +hkern_ :: [Attribute] -> Element +hkern_ = with $ makeElementNoEnd "hkern" + +-- | @image@ element +image_ :: Term result => [Attribute] -> result +image_ = term "image" + +-- | @line@ element +line_ :: Term result => [Attribute] -> result +line_ = term "line" + +-- | @lineargradient@ element +linearGradient_ :: Term result => [Attribute] -> result +linearGradient_ = term "linearGradient" + +-- | @marker@ element +marker_ :: Term result => [Attribute] -> result +marker_ = term "marker" + +-- | @mask@ element or attribute +mask_ :: Term result => [Attribute] -> result +mask_ = term "mask" + +-- | @metadata@ element +metadata_ :: Term result => [Attribute] -> result +metadata_ = term "metadata" + +-- | @missingGlyph@ element +missingGlyph_ :: Term result => [Attribute] -> result +missingGlyph_ = term "missing-glyph" + +-- | @mpath@ element +mpath_ :: Term result => [Attribute] -> result +mpath_ = term "mpath" + +-- | @path@ element +path_ :: Term result => [Attribute] -> result +path_ = term "path" + +-- | @pattern@ element +pattern_ :: Term result => [Attribute] -> result +pattern_ = term "pattern" + +-- | @polygon@ element +polygon_ :: Term result => [Attribute] -> result +polygon_ = term "polygon" + +-- | @polyline@ element +polyline_ :: Term result => [Attribute] -> result +polyline_ = term "polyline" + +-- | @radialgradient@ element +radialGradient_ :: Term result => [Attribute] -> result +radialGradient_ = term "radialGradient" + +-- | @rect@ element +rect_ :: Term result => [Attribute] -> result +rect_ = term "rect" + +-- | @script@ element +script_ :: Term result => [Attribute] -> result +script_ = term "script" + +-- | @set@ element +set_ :: Term result => [Attribute] -> result +set_ = term "set" + +-- | @stop@ element +stop_ :: Term result => [Attribute] -> result +stop_ = term "stop" + +-- | @style@ element +style_ :: Term result => [Attribute] -> result +style_ = term "style" + +-- | @svg@ element +svg_ :: Term result => [Attribute] -> result +svg_ = term "svg" + +-- | @switch@ element +switch_ :: Term result => [Attribute] -> result +switch_ = term "switch" + +-- | @symbol@ element +symbol_ :: Term result => [Attribute] -> result +symbol_ = term "symbol" + +-- | @text_@ element +text_ :: Term result => [Attribute] -> result +text_ = term "text" + +-- | @textpath@ element +textPath_ :: Term result => [Attribute] -> result +textPath_ = term "textPath" + +-- | @title@ element +title_ :: Term result => [Attribute] -> result +title_ = term "title" + +-- | @tref@ element +tref_ :: Term result => [Attribute] -> result +tref_ = term "tref" + +-- | @tspan@ element +tspan_ :: Term result => [Attribute] -> result +tspan_ = term "tspan" + +-- | @use@ element +use_ :: Term result => [Attribute] -> result +use_ = term "use" + +-- | @view@ element +view_ :: Term result => [Attribute] -> result +view_ = term "view" + +-- | @vkern@ element +vkern_ :: [Attribute] -> Element +vkern_ = with $ makeElementNoEnd "vkern" diff --git a/src/Graphics/Svg/Path.hs b/src/Graphics/Svg/Path.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Svg/Path.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Svg.Path +-- Copyright : (c) 2015 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- Utility functions to help create SVG path attributes, +-- and transforms. +-- +------------------------------------------------------------------------------- + +module Graphics.Svg.Path where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) +import Data.Text.Lazy.Builder.RealFloat + +-- | Convert a number to Text. +toText :: RealFloat a => a -> Text +toText = toStrict . toLazyText . formatRealFloat Fixed (Just 4) + +-- | moveto (absolute) +mA :: RealFloat a => a -> a -> Text +mA x y = T.concat ["M " ,toText x, ",", toText y, " "] + +-- | moveto (relative) +mR :: RealFloat a => a -> a -> Text +mR dx dy = T.concat ["m ", toText dx, ",", toText dy, " "] + +-- | lineto (absolute) +lA :: RealFloat a => a -> a -> Text +lA x y = T.concat ["L ", toText x, ",", toText y, " "] + +-- | lineto (relative) +lR :: RealFloat a => a -> a -> Text +lR dx dy = T.concat ["l ", toText dx, ",", toText dy, " "] + +-- | horizontal lineto (absolute) +hA :: RealFloat a => a -> Text +hA x = T.concat ["H ", toText x, " "] + +-- | horizontal lineto (relative) +hR :: RealFloat a => a -> Text +hR dx = T.concat ["h ", toText dx, " "] + +-- | vertical lineto (absolute) +vA :: RealFloat a => a -> Text +vA y = T.concat ["V ", toText y, " "] + +-- | vertical lineto (relative) +vR :: RealFloat a => a -> Text +vR dy = T.concat ["v ", toText dy, " "] + +-- | Cubic Bezier curve (absolute) +cA :: RealFloat a => a -> a -> a -> a -> a -> a -> Text +cA c1x c1y c2x c2y x y = T.concat + [ "C ", toText c1x, ",", toText c1y, " ", toText c2x, "," + , toText c2y, " ", toText x, " ", toText y] + +-- | Cubic Bezier curve (relative) +cR :: RealFloat a => a -> a -> a -> a -> a -> a -> Text +cR dc1x dc1y dc2x dc2y dx dy = T.concat + [ "c ", toText dc1x, ",", toText dc1y, " ", toText dc2x + , ",", toText dc2y, " ", toText dx, " ", toText dy] + +-- | Smooth Cubic Bezier curve (absolute) +sA :: RealFloat a => a -> a -> a -> a -> Text +sA c2x c2y x y = T.concat + ["S ", toText c2x, ",", toText c2y, " ", toText x, ",", toText y, " "] + +-- | Smooth Cubic Bezier curve (relative) +sR :: RealFloat a => a -> a -> a -> a -> Text +sR dc2x dc2y dx dy = T.concat + ["s ", toText dc2x, ",", toText dc2y, " ", toText dx, ",", toText dy, " "] + +-- | Quadratic Bezier curve (absolute) +qA :: RealFloat a => a -> a -> a -> a -> Text +qA cx cy x y = T.concat + ["Q ", toText cx, ",", toText cy, " ", toText x, ",", toText y, " "] + +-- | Quadratic Bezier curve (relative) +qR :: RealFloat a => a -> a -> a -> a -> Text +qR dcx dcy dx dy = T.concat + ["q ", toText dcx, ",", toText dcy, " ", toText dx, ",", toText dy, " " ] + +-- | Smooth Quadratic Bezier curve (absolute) +tA :: RealFloat a => a -> a -> Text +tA x y = T.concat ["T ", " ", toText x, ",", toText y, " "] + +-- | Smooth Quadratic Bezier curve (relative) +tR :: RealFloat a => a -> a -> Text +tR x y = T.concat [ "t ", toText x, ",", toText y, " "] + +-- | Arc (absolute) +aA :: RealFloat a => a -> a -> a -> a -> a -> a -> a -> Text +aA rx ry xrot largeFlag sweepFlag x y = T.concat + [ "A ", toText rx, ",", toText ry, " ", toText xrot, " ", toText largeFlag + , " ", toText sweepFlag, " ", toText x, " ", toText y, " "] + +-- | Arc (relative) +aR :: RealFloat a => a -> a -> a -> a -> a -> a -> a -> Text +aR rx ry xrot largeFlag sweepFlag x y = T.concat + [ "a ", toText rx, ",", toText ry, " ", toText xrot, " ", toText largeFlag + , " ", toText sweepFlag, " ", toText x, " ", toText y, " "] + +-- | closepath +z :: Text +z = "Z" + +-- | SVG Transform components +-- | Specifies a translation by @x@ and @y@ +translate :: RealFloat a => a -> a -> Text +translate x y = T.concat ["translate(", toText x, " ", toText y, ")"] + +-- | Specifies a scale operation by @x@ and @y@ +scale :: RealFloat a => a -> a -> Text +scale x y = T.concat ["scale(", toText x, " ", toText y, ")"] + +-- | Specifies a rotation by @rotate-angle@ degrees +rotate :: RealFloat a => a -> Text +rotate angle = T.concat ["rotate(", toText angle, ")"] + +-- | Specifies a rotation by @rotate-angle@ degrees about the given time @rx,ry@ +rotateAround :: RealFloat a => a -> a -> a -> Text +rotateAround angle rx ry = T.concat + ["rotate(", toText angle, ",", toText rx, ",", toText ry, ")"] + +-- | Skew tansformation along x-axis +skewX :: RealFloat a => a -> Text +skewX angle = T.concat ["skewX(", toText angle, ")"] + +-- | Skew tansformation along y-axis +skewY :: RealFloat a => a -> Text +skewY angle = T.concat ["skewY(", toText angle, ")"] + +-- | Specifies a transform in the form of a transformation matrix +matrix :: RealFloat a => a -> a -> a -> a -> a -> a -> Text +matrix a b c d e f = T.concat + [ "matrix(", toText a, ",", toText b, ",", toText c + , ",", toText d, ",", toText e, ",", toText f, ")"] diff --git a/svg-builder.cabal b/svg-builder.cabal new file mode 100644 --- /dev/null +++ b/svg-builder.cabal @@ -0,0 +1,30 @@ +name: svg-builder +version: 0.1 +synopsis: DSL for building SVG. +description: Fast, easy to write SVG. +homepage: http://github.com/jeffreyrosenbluth/svg-builder.git +license: BSD3 +license-file: LICENSE +author: Jeffrey Rosenbluth +maintainer: jeffrey.rosenbluth@gmail.com +copyright: 2016 Jeffrey Rosenbluth +category: Graphics +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + ghc-options: -Wall -rtsopts -O2 + exposed-modules: Graphics.Svg, + Graphics.Svg.Core, + Graphics.Svg.Path, + Graphics.Svg.Elements, + Graphics.Svg.Attributes + build-depends: base >= 4.5 && < 4.10, + blaze-builder >= 0.4 && < 0.5, + bytestring >= 0.10 && < 0.11, + hashable >= 1.1 && < 1.3, + text >= 0.11 && < 1.3, + unordered-containers >= 0.2 && < 0.2.7 + hs-source-dirs: src + default-language: Haskell2010