diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Frank Staals + +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 Frank Staals 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,6 @@ +HGeometry-Svg +============= + +Writing geometric data from +[HGeometry](https://hackage.haskell.org/package/hgeometry) to svg +files. 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/changelog.org b/changelog.org new file mode 100644 --- /dev/null +++ b/changelog.org diff --git a/doctests.hs b/doctests.hs new file mode 100644 --- /dev/null +++ b/doctests.hs @@ -0,0 +1,54 @@ +import Test.DocTest + +main :: IO () +main = doctest $ ["-isrc" ] ++ ghcExts ++ files + +ghcExts :: [String] +ghcExts = map ("-X" ++) + [ "TypeFamilies" + , "GADTs" + , "KindSignatures" + , "DataKinds" + , "TypeOperators" + , "ConstraintKinds" + , "PolyKinds" + , "RankNTypes" + , "TypeApplications" + , "ScopedTypeVariables" + + , "PatternSynonyms" + , "ViewPatterns" + , "TupleSections" + , "MultiParamTypeClasses" + , "LambdaCase" + , "TupleSections" + + + , "StandaloneDeriving" + , "GeneralizedNewtypeDeriving" + , "DeriveFunctor" + , "DeriveFoldable" + , "DeriveTraversable" + , "AutoDeriveTypeable" + , "DeriveGeneric" + , "FlexibleInstances" + , "FlexibleContexts" + ] + +files :: [String] +files = map toFile modules + +toFile :: String -> String +toFile = (\s -> "src/" <> s <> ".hs") . replace '.' '/' + +replace :: Eq a => a -> a -> [a] -> [a] +replace a b = go + where + go [] = [] + go (c:cs) | c == a = b:go cs + | otherwise = c:go cs + +modules :: [String] +modules = + [ "Data.Geometry.Svg" + ] diff --git a/hgeometry-svg.cabal b/hgeometry-svg.cabal new file mode 100644 --- /dev/null +++ b/hgeometry-svg.cabal @@ -0,0 +1,117 @@ +name: hgeometry-svg +version: 0.9.0.0 +synopsis: Writing geometric primitives from HGeometry as SVG Files +description: + Writing geometric primitives from HGeometry as SVG Files. + +homepage: https://fstaals.net/software/hgeometry +license: BSD3 +license-file: LICENSE +author: Frank Staals +maintainer: frank@fstaals.net +-- copyright: + +tested-with: GHC >= 8.2 + +category: Geometry +build-type: Simple + +data-files: + -- in the future (cabal >=2.4) we can use + -- examples/**/*.in + -- examples/**/*.out + +extra-source-files: README.md + changelog.org + +Extra-doc-files: + -- docs/**/*.png + +cabal-version: 2.0 +source-repository head + type: git + location: https://github.com/noinia/hgeometry + +library + ghc-options: -Wall -fno-warn-unticked-promoted-constructors -fno-warn-type-defaults + + exposed-modules: + Data.Geometry.Svg + Data.Geometry.Svg.MathCoordinateSystem + Data.Geometry.Svg.Writer + + -- other-extensions: + build-depends: + base >= 4.11 && < 5 + , hgeometry >= 0.9.0.0 + , hgeometry-combinatorial >= 0.9.0.0 + , hgeometry-ipe >= 0.9.0.0 + , bytestring >= 0.10 + , lens >= 4.2 + , semigroups >= 0.18 + , deepseq >= 1.1 + , vinyl >= 0.10 + , semigroupoids >= 5 + , singletons >= 2.0 + , blaze-svg >= 0.3.6 + , blaze-markup >= 0.8 + , text >= 1.1.1.0 + + , QuickCheck + -- , bifunctors >= 4.1 + -- , containers >= 0.5.5 + -- , dlist >= 0.7 + -- , contravariant >= 1.4 + -- , profunctors >= 5.2.1 + -- , linear >= 1.10 + + + + -- , colour >= 2.3.3 + + , template-haskell + + + hs-source-dirs: src + -- examples/demo + + default-language: Haskell2010 + + default-extensions: TypeFamilies + , GADTs + , KindSignatures + , DataKinds + , TypeOperators + , ConstraintKinds + , PolyKinds + , RankNTypes + , TypeApplications + , ScopedTypeVariables + + , PatternSynonyms + , TupleSections + , LambdaCase + , ViewPatterns + + , StandaloneDeriving + , GeneralizedNewtypeDeriving + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , DeriveGeneric + , AutoDeriveTypeable + + + , FlexibleInstances + , FlexibleContexts + , MultiParamTypeClasses + +test-suite doctests + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: doctests.hs + build-depends: base + , doctest >= 0.8 +-- , doctest-discover + + default-language: Haskell2010 diff --git a/src/Data/Geometry/Svg.hs b/src/Data/Geometry/Svg.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geometry/Svg.hs @@ -0,0 +1,19 @@ +module Data.Geometry.Svg( module Data.Geometry.Svg.Writer + , svgViaIpe + ) where + +import Data.Geometry.Ipe.IpeOut +import Data.Geometry.Svg.Writer +import qualified Text.Blaze.Svg as Svg +import Data.Geometry.Ipe.Types(ToObject(..)) + +-- $setup +-- >>> import Data.Geometry.Point + + +-- | Convert an input into svg via ipe +-- +-- >>> printSvgXMLElem $ svgViaIpe defIO (origin :: Point 2 Rational) +-- +svgViaIpe :: (ToObject i, Real r) => IpeOut g i r -> g -> Svg.Svg +svgViaIpe mkIO = svgO . iO . mkIO diff --git a/src/Data/Geometry/Svg/MathCoordinateSystem.hs b/src/Data/Geometry/Svg/MathCoordinateSystem.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geometry/Svg/MathCoordinateSystem.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | +-- Module : Data.Geometry.Svg.MathCoordinateSystem +-- Copyright : (C) Frank Staals +-- License : see the LICENSE file +-- Maintainer : Frank Staals +-- Description : +-- +-- Defines functions to make sure we render the coordinate system in +-- svg correctly, i.e. with the origin in the bottom-left instead of +-- top-left. +-- +-------------------------------------------------------------------------------- +module Data.Geometry.Svg.MathCoordinateSystem( Canvas(Canvas) + , center, dimensions, zoomLevel + , createCanvas + , renderCanvas, text_ + , realWorldCoordinates + + , toAValue, toPValue, showP + ) where + +import Control.Lens hiding (view, element) +import Data.Fixed +import Data.Geometry.Point +import Data.Geometry.Vector +import qualified Data.List as List +import Data.Text (Text) +import Data.Util (SP(..)) +import Prelude hiding ((!!)) +import Text.Blaze.Internal (Attributable(..)) +import Text.Blaze.Svg11 ((!)) +import qualified Text.Blaze.Svg11 as Svg +import qualified Text.Blaze.Svg11.Attributes as A + +-------------------------------------------------------------------------------- + +-- | Svg Canvas that has a "proper" Coordinate system whose origin is in the bottom left. +data Canvas r = Canvas { _dimensions :: Vector 2 Int + -- ^ dimensions (width,height) of the canvas + , _center :: Point 2 r + -- ^ the center point (in world coordinates) + -- of the viewport of the canvas. + , _zoomLevel :: r + -- ^ determines the zoomlevel of the + -- canvas. At zoomlevel z the width and + -- height (in terms of world coordinates) + -- that we can see are z*dimensions + } deriving (Show,Eq) + +center :: Lens' (Canvas r) (Point 2 r) +center = lens _center (\cv c -> cv { _center = c } ) + +dimensions :: Lens' (Canvas r) (Vector 2 Int) +dimensions = lens _dimensions (\cv c -> cv { _dimensions = c } ) + +zoomLevel :: Lens' (Canvas r) r +zoomLevel = lens _zoomLevel (\cv c -> cv { _zoomLevel = c } ) + +-------------------------------------------------------------------------------- + +-- | Create a canvas +createCanvas :: Num r => Int -> Int -> Canvas r +createCanvas w h = Canvas (Vector2 w h) (fromIntegral <$> Point2 (w `div` 2) (h `div` 2)) 1 + +-------------------------------------------------------------------------------- + + +-- | Draws the actual canvas +renderCanvas :: RealFrac r + => Canvas r -> [Svg.Attribute] -> Svg.Svg -> Svg.Svg +renderCanvas cv ats vs = Svg.svg ! A.width (toPValue w) + ! A.height (toPValue h) + ! A.viewbox outerVB + ! A.style "border-style: solid" + !! ats + $ Svg.g ! A.transform "scale(1,-1)" + $ Svg.svg ! A.width "100%" + ! A.height "100%" + ! A.viewbox innerVB + $ vs + where + Vector2 w h = cv^.dimensions + + SP (Point2 lx ly) (Vector2 vw vh) = bimap (fmap round) (fmap round) $ viewRectangle cv + + + toVB = mconcat @Svg.AttributeValue . List.intersperse " " . map toPValue + outerVB = toVB [0, (-1) * h, w, h] + -- the role of the outer viewBox is to flip the coordinate + -- system s.t. the origin is in the bottom left rather + -- than the top-left + innerVB = toVB [lx, ly, vw, vh] + +-- | Computes the view rectangle of the canvas; given by the lower left point and +-- the dimensions (in real coordinates). +viewRectangle :: Fractional r => Canvas r -> SP (Point 2 r) (Vector 2 r) +viewRectangle cv = SP (Point2 (cx - (vw / 2)) (cy - (vh / 2))) + dims + where + Point2 cx cy = cv^.center + dims@(Vector2 vw vh) = (1 / cv^.zoomLevel) *^ (fromIntegral <$> cv^.dimensions) + +infixl 9 !! +(!!) :: Attributable t => t -> [Svg.Attribute] -> t +t !! ats = List.foldl' (!) t ats + + +-- | To be used instead of the text_ combinator in Blaze +text_ :: Real r + => Point 2 r -- ^ position where to draw (in world coordinates) + -> [Svg.Attribute] + -> Text -> Svg.Svg +text_ (Point2 x y) ats t = Svg.g ! A.transform (mconcat [ "translate(" + , toPValue x + , ", " + , toPValue y + , ")scale(1,-1)" + ]) + $ Svg.text_ !! ats + $ Svg.text t + +-------------------------------------------------------------------------------- + +-- | Computes the mouse position in terms of real world coordinates. +-- pre: the coordinates given lie on the canvas +realWorldCoordinates :: Fractional r => Canvas r -> Point 2 Int -> Point 2 r +realWorldCoordinates cv (Point2 x y) = + applyViewBox cv $ Point2 x ((cv^.dimensions.element (C @ 1)) - y) + -- position relative to the outer viewbox + +-- | Applies the viewbox transformation +applyViewBox :: Fractional r => Canvas r -> Point 2 Int -> Point 2 r +applyViewBox cv p = Point2 (lx + (x/w) * vw) (ly + (y/h)*vh) + where + (Vector2 w h) = fromIntegral <$> cv^.dimensions + SP (Point2 lx ly) (Vector2 vw vh) = viewRectangle cv + Point2 x y = fromIntegral <$> p + +-------------------------------------------------------------------------------- + +toAValue :: Show a => a -> Svg.AttributeValue +toAValue = Svg.toValue . show + +toPValue :: Real r => r -> Svg.AttributeValue +toPValue = toAValue . showP + +-- | show by converting to a Pico +showP :: Real a => a -> Pico +showP = realToFrac diff --git a/src/Data/Geometry/Svg/Writer.hs b/src/Data/Geometry/Svg/Writer.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geometry/Svg/Writer.hs @@ -0,0 +1,274 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | +-- Module : Data.Geometry.Svg.Writer +-- Copyright : (C) Frank Staals +-- License : see the LICENSE file +-- Maintainer : Frank Staals +-- Description : +-- +-- Write geometry to svg +-- +-------------------------------------------------------------------------------- +module Data.Geometry.Svg.Writer where + +import Control.Lens hiding (rmap, Const(..)) +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.Char8 as B8 +import Data.Ext +import Data.Fixed +import qualified Data.Foldable as F +import qualified Data.Geometry.Ipe.Attributes as IA +import Data.Geometry.Ipe.Color (IpeColor(..)) +import Data.Geometry.Ipe.Types +import qualified Data.Geometry.Ipe.Types as Ipe +import Data.Geometry.Ipe.Value (IpeValue(..)) +import Data.Geometry.Point +import Data.Geometry.PolyLine +import Data.Geometry.Polygon +import Data.Geometry.Svg.MathCoordinateSystem +import Data.Geometry.Transformation (Matrix) +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Maybe +import Data.Monoid (mconcat) +import Data.Proxy +import Data.Ratio +import Data.Semigroup.Foldable (toNonEmpty) +import Data.Singletons (Apply) +import Data.Vinyl hiding (Label) +import Data.Vinyl.Functor +import Data.Vinyl.TypeLevel +import Text.Blaze (ToMarkup(toMarkup), ToValue(toValue)) +import qualified Text.Blaze.Svg as Svg +import qualified Text.Blaze.Svg.Renderer.Utf8 as SvgRender +import Text.Blaze.Svg11 ((!)) +import qualified Text.Blaze.Svg11 as Svg +import qualified Text.Blaze.Svg11.Attributes as A + +-------------------------------------------------------------------------------- + +-- | Converts an element into a valid svg document (including doctype etc.) +-- The size of the resulting svg is set to 800x600. Moreover, we flip the axes +-- so that the origin is in the bottom-left. +-- +-- +toSvgXML :: ToMarkup t => t -> B.ByteString +toSvgXML = SvgRender.renderSvg + . Svg.docTypeSvg + . renderCanvas (createCanvas @Double 800 600) [] + . svgO + +-- | Convert an element to Svg using 'toSvgXML' and prints the resulting svg +-- (as xml) output to stdout. +-- +printSvgXML :: ToMarkup t => t -> IO () +printSvgXML = B8.putStrLn . toSvgXMLElem + + +-- | Convert an element to Svg +svgO :: ToMarkup a => a -> Svg.Svg +svgO = Svg.toSvg + + +-- | Convert an element to Svg, and render this svg as xml. Note that the xml +-- contains *only* this element. +toSvgXMLElem :: ToMarkup t => t -> B.ByteString +toSvgXMLElem = SvgRender.renderSvg . Svg.toSvg + +-- | Convert an element to Svg, and prints the xml output to stdout. +printSvgXMLElem :: ToMarkup t => t -> IO () +printSvgXMLElem = B8.putStrLn . toSvgXMLElem + + +-------------------------------------------------------------------------------- + +instance Real r => ToMarkup (IpeObject r) where + toMarkup (IpeGroup g) = toMarkup g + toMarkup (IpeImage i) = toMarkup i + toMarkup (IpeTextLabel t) = toMarkup t + toMarkup (IpeMiniPage m) = toMarkup m + toMarkup (IpeUse u) = toMarkup u + toMarkup (IpePath (p :+ ats)) = toMarkup $ p :+ (ats' <> ats) + where + ats' = IA.attr IA.SFill $ IpeColor $ Named "transparent" + -- svg assumes that by default the filling is set to transparent + -- so make sure we do that as well + +instance ( ToMarkup g + , AllConstrained IpeToSvgAttr rs + , ReifyConstraint ToValue (IA.Attr f) rs + , RMap rs, RecordToList rs + , RecAll (IA.Attr f) rs ToValue + ) => ToMarkup (g :+ IA.Attributes f rs) where + toMarkup (i :+ ats) = toMarkup i `applyAts` svgWriteAttrs ats + +instance Real r => ToMarkup (TextLabel r) where + toMarkup (Label t p) = text_ p [] t + +instance Real r => ToMarkup (MiniPage r) where + toMarkup (MiniPage t p w) = text_ p [A.width (toPValue w)] t + +instance Real r => ToMarkup (Image r) where + toMarkup _ = error "ToMarkup: Image not implemented yet" + -- toMarkup (Image i r) = Svg.image t ! A.xlinkHref (toAValue i) + -- ! A.y (toPValue $ p^.yCoord) + -- ! A.width (toPValue w) + + + +instance HasResolution p => ToValue (Fixed p) where + toValue = toAValue + +instance Integral a => ToValue (Ratio a) where + toValue = toValue @Pico . realToFrac + +instance Real r => ToValue (PathSegment r) where + toValue = \case + PolyLineSegment pl -> Svg.mkPath . toPath $ pl^.points.to toNonEmpty + PolygonPath pg -> Svg.mkPath $ do toPath $ pg^.outerBoundary.to toNonEmpty + Svg.z + EllipseSegment _ -> undefined + _ -> error "toValue: not implemented yet" + +toPath :: Real r => NonEmpty (Point 2 r :+ p) -> Svg.Path +toPath pts = case (^.core) <$> pts of + (v:|vs) -> do Svg.m (showP $ v^.xCoord) (showP $ v^.yCoord) + mapM_ (\(Point2 x y) -> Svg.l (showP x) (showP y)) vs + + +instance Real r => ToMarkup (Ipe.Path r) where + toMarkup p = Svg.path ! A.d (toValue p) + +instance Real r => ToValue (Path r) where + toValue (Path s) = mconcat . map toValue . F.toList $ s + +instance Real r => ToMarkup (Ipe.IpeSymbol r) where + toMarkup (Symbol p _) = Svg.circle ! A.cx (toPValue $ p^.xCoord) + ! A.cy (toPValue $ p^.yCoord) + ! A.r (toPValue 5) + -- TODO: for now just draw a disk of fixed radius + +instance Real r => ToMarkup (Ipe.Group r) where + toMarkup (Group os) = Svg.g (mapM_ toMarkup os) + +-------------------------------------------------------------------------------- +-- * Dealing with attributes + +instance ToValue (Apply f at) => ToValue (IA.Attr f at) where + toValue att = maybe mempty toValue $ IA._getAttr att + + +applyAts :: Svg.Markup -> [(SvgF, Svg.AttributeValue)] -> Svg.Markup +applyAts x0 = F.foldl' (\x (f,v) -> x ! f v) x0 + +-- | Functon to write all attributes in a Rec +svgWriteAttrs :: ( AllConstrained IpeToSvgAttr rs + , RMap rs, RecordToList rs + , ReifyConstraint ToValue (IA.Attr f) rs + , RecAll (IA.Attr f) rs ToValue + ) + => IA.Attributes f rs + -> [(SvgF, Svg.AttributeValue)] +svgWriteAttrs (IA.Attrs r) = catMaybes . recordToList $ IA.zipRecsWith f (writeAttrFunctions r) + (writeAttrValues r) + where + f (Const mn) (Const mv) = Const $ (,) <$> mn <*> mv + +-- | Writing Attribute names +writeAttrFunctions :: AllConstrained IpeToSvgAttr rs + => Rec f rs + -> Rec (Const (Maybe SvgF)) rs +writeAttrFunctions RNil = RNil +writeAttrFunctions (x :& xs) = Const (write'' x) :& writeAttrFunctions xs + where + write'' :: forall f s. IpeToSvgAttr s => f s -> Maybe SvgF + write'' _ = attrSvg (Proxy :: Proxy s) + + +-- | Writing the attribute values +writeAttrValues :: ( ReifyConstraint ToValue (IA.Attr f) rs, RMap rs + , RecAll (IA.Attr f) rs ToValue) + => Rec (IA.Attr f) rs -> Rec (Const (Maybe Svg.AttributeValue)) rs +writeAttrValues = rmap (\(Compose (Dict x)) -> Const $ toMaybeValue x) + . reifyConstraint @ToValue + +toMaybeValue :: ToValue (IA.Attr f at) => IA.Attr f at -> Maybe Svg.AttributeValue +toMaybeValue a = case a of + IA.NoAttr -> Nothing + IA.Attr _ -> Just $ toValue a + +type SvgF = Svg.AttributeValue -> Svg.Attribute + + + +-- | For the types representing attribute values we can get the name/key to use +-- when serializing to ipe. +class IpeToSvgAttr (a :: IA.AttributeUniverse) where + attrSvg :: proxy a -> Maybe SvgF + +-- CommonAttributeUnivers +instance IpeToSvgAttr IA.Layer where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Matrix where attrSvg _ = Nothing -- TODO +instance IpeToSvgAttr IA.Pin where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Transformations where attrSvg _ = Nothing + +-- IpeSymbolAttributeUniversre +instance IpeToSvgAttr IA.Stroke where attrSvg _ = Just A.stroke +instance IpeToSvgAttr IA.Fill where attrSvg _ = Just A.fill +instance IpeToSvgAttr IA.Pen where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Size where attrSvg _ = Nothing + +-- PathAttributeUniverse +instance IpeToSvgAttr IA.Dash where attrSvg _ = Nothing +instance IpeToSvgAttr IA.LineCap where attrSvg _ = Just A.strokeLinecap +instance IpeToSvgAttr IA.LineJoin where attrSvg _ = Nothing +instance IpeToSvgAttr IA.FillRule where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Arrow where attrSvg _ = Nothing +instance IpeToSvgAttr IA.RArrow where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Opacity where attrSvg _ = Just A.opacity +instance IpeToSvgAttr IA.Tiling where attrSvg _ = Nothing +instance IpeToSvgAttr IA.Gradient where attrSvg _ = Nothing + +-- GroupAttributeUniverse +instance IpeToSvgAttr IA.Clip where attrSvg _ = Just A.clip + + + +-------------------------------------------------------------------------------- + +deriving instance ToValue LayerName + +instance Real r => ToValue (IpeColor r) where + toValue (IpeColor c) = case c of + Named t -> toValue t + Valued v -> toAValue $ fmap showP v + +-- TODO: + + + +instance Real r => ToValue (IA.IpePen r) where + toValue _ = mempty + +instance Real r => ToValue (IA.IpeSize r) where + toValue _ = mempty + +instance Real r => ToValue (IA.IpeArrow r) where + toValue _ = mempty + +instance Real r => ToValue (IA.IpeDash r) where + toValue _ = mempty + +instance Real r => ToValue (Matrix 3 3 r) where + toValue _ = mempty + +instance ToValue IA.FillType where + toValue _ = mempty + +instance ToValue IA.PinType where + toValue _ = mempty + +instance ToValue IA.TransformationTypes where + toValue _ = mempty