hgeometry-svg (empty) → 0.9.0.0
raw patch · 9 files changed
+654/−0 lines, 9 filesdep +QuickCheckdep +basedep +blaze-markupsetup-changed
Dependencies added: QuickCheck, base, blaze-markup, blaze-svg, bytestring, deepseq, doctest, hgeometry, hgeometry-combinatorial, hgeometry-ipe, lens, semigroupoids, semigroups, singletons, template-haskell, text, vinyl
Files
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
- changelog.org +0/−0
- doctests.hs +54/−0
- hgeometry-svg.cabal +117/−0
- src/Data/Geometry/Svg.hs +19/−0
- src/Data/Geometry/Svg/MathCoordinateSystem.hs +152/−0
- src/Data/Geometry/Svg/Writer.hs +274/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,6 @@+HGeometry-Svg+=============++Writing geometric data from+[HGeometry](https://hackage.haskell.org/package/hgeometry) to svg+files.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.org view
+ doctests.hs view
@@ -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"+ ]
+ hgeometry-svg.cabal view
@@ -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
+ src/Data/Geometry/Svg.hs view
@@ -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)+-- <circle cx="0.000000000000" cy="0.000000000000" r="5.000000000000" />+svgViaIpe :: (ToObject i, Real r) => IpeOut g i r -> g -> Svg.Svg+svgViaIpe mkIO = svgO . iO . mkIO
+ src/Data/Geometry/Svg/MathCoordinateSystem.hs view
@@ -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
+ src/Data/Geometry/Svg/Writer.hs view
@@ -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