Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- _asLineSegment :: Prism' (Path r) (LineSegment 2 () r)
- _asPolyLine :: Prism' (Path r) (PolyLine 2 () r)
- _asSimplePolygon :: Prism' (Path r) (Polygon Simple () r)
- _asMultiPolygon :: Prism' (Path r) (MultiPolygon () r)
- polygonToPath :: Polygon t () r -> Path r
- pathToPolygon :: Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r))
- _withAttrs :: Prism' (IpeObject r) (i r :+ IpeAttributes i r) -> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r)
- class HasDefaultFromIpe g where
- type DefaultFromIpe g :: * -> *
- readAll :: (HasDefaultFromIpe g, r ~ NumType g, Foldable f) => f (IpePage r) -> [g :+ IpeAttributes (DefaultFromIpe g) r]
- readAllFrom :: (HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r) => FilePath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
Documentation
>>>
:{
import Data.Geometry.Ipe.Attributes
let testPath :: Path Int testPath = Path . S2.l1Singleton . PolyLineSegment . PolyLine.fromPoints . map ext $ [ origin, point2 10 10, point2 200 100 ]
testPathAttrs :: IpeAttributes Path Int testPathAttrs = attr SStroke (IpeColor (Named "red"))
_asLineSegment :: Prism' (Path r) (LineSegment 2 () r) Source #
Try to convert a path into a line segment, fails if the path is not a line segment or a polyline with more than two points.
_asPolyLine :: Prism' (Path r) (PolyLine 2 () r) Source #
Convert to a polyline. Ignores all non-polyline parts
>>>
testPath ^? _asPolyLine
Just (PolyLine {_points = Seq2 (Point2 [0,0] :+ ()) (fromList [Point2 [10,10] :+ ()]) (Point2 [200,100] :+ ())})
_asMultiPolygon :: Prism' (Path r) (MultiPolygon () r) Source #
Convert to a multipolygon
polygonToPath :: Polygon t () r -> Path r Source #
pathToPolygon :: Path r -> Maybe (Either (SimplePolygon () r) (MultiPolygon () r)) Source #
_withAttrs :: Prism' (IpeObject r) (i r :+ IpeAttributes i r) -> Prism' (i r) g -> Prism' (IpeObject r) (g :+ IpeAttributes i r) Source #
use the first prism to select the ipe object to depicle with, and the second how to select the geometry object from there on. Then we can select the geometry object, directly with its attributes here.
>>>
testObject ^? _withAttrs _IpePath _asPolyLine
Just (PolyLine {_points = Seq2 (Point2 [0,0] :+ ()) (fromList [Point2 [10,10] :+ ()]) (Point2 [200,100] :+ ())} :+ Attrs {_unAttrs = {GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Just (IpeColor (Named "red"))}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}, GAttr {_getAttr = Nothing}}})
class HasDefaultFromIpe g where Source #
type DefaultFromIpe g :: * -> * Source #
defaultFromIpe :: r ~ NumType g => Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r) Source #
Instances
readAll :: (HasDefaultFromIpe g, r ~ NumType g, Foldable f) => f (IpePage r) -> [g :+ IpeAttributes (DefaultFromIpe g) r] Source #
Read all g's from some ipe page(s).
readAllFrom :: (HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r) => FilePath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r] Source #
Convenience function from reading all g's from an ipe file. If there is an error reading or parsing the file the error is "thrown away".