Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | GHC2021 |
Reexports the functionality for reading and writing Ipe files.
Synopsis
- data IpeFile r = IpeFile (Maybe IpePreamble) [IpeStyle] (NonEmpty (IpePage r))
- preamble :: forall r f. Functor f => (Maybe IpePreamble -> f (Maybe IpePreamble)) -> IpeFile r -> f (IpeFile r)
- styles :: forall r f. Functor f => ([IpeStyle] -> f [IpeStyle]) -> IpeFile r -> f (IpeFile r)
- pages :: forall r r' f. Functor f => (NonEmpty (IpePage r) -> f (NonEmpty (IpePage r'))) -> IpeFile r -> f (IpeFile r')
- ipeFile :: NonEmpty (IpePage r) -> IpeFile r
- singlePageFile :: IpePage r -> IpeFile r
- singlePageFromContent :: [IpeObject r] -> IpeFile r
- readIpeFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpeFile r))
- readSinglePageFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpePage r))
- readSinglePageFileThrow :: (Coordinate r, Eq r) => OsPath -> IO (IpePage r)
- readRawIpeFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpeFile r))
- type ConversionError = Text
- readAll :: (HasDefaultFromIpe g, r ~ NumType g) => IpePage r -> [g :+ IpeAttributes (DefaultFromIpe g) r]
- readAllFrom :: (HasDefaultFromIpe g, r ~ NumType g, Coordinate r, Eq r) => OsPath -> IO [g :+ IpeAttributes (DefaultFromIpe g) r]
- writeIpeFile :: IpeWriteText r => OsPath -> IpeFile r -> IO ()
- writeIpeFile' :: IpeWrite t => t -> OsPath -> IO ()
- writeIpePage :: IpeWriteText r => OsPath -> IpePage r -> IO ()
- toIpeXML :: IpeWrite t => t -> Maybe ByteString
- printAsIpeSelection :: IpeWrite t => t -> IO ()
- toIpeSelectionXML :: IpeWrite t => t -> Maybe ByteString
- data IpePage r = IpePage [LayerName] [View] [IpeObject r]
- layers :: forall r f. Functor f => ([LayerName] -> f [LayerName]) -> IpePage r -> f (IpePage r)
- views :: forall r f. Functor f => ([View] -> f [View]) -> IpePage r -> f (IpePage r)
- content :: forall r r' f. Functor f => ([IpeObject r] -> f [IpeObject r']) -> IpePage r -> f (IpePage r')
- emptyPage :: IpePage r
- fromContent :: [IpeObject r] -> IpePage r
- onLayer :: LayerName -> Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r)
- contentInView :: Word -> Getter (IpePage r) [IpeObject r]
- withDefaults :: IpePage r -> IpePage r
- data IpeObject r
- = IpeGroup (IpeObject' Group r)
- | IpeImage (IpeObject' Image r)
- | IpeTextLabel (IpeObject' TextLabel r)
- | IpeMiniPage (IpeObject' MiniPage r)
- | IpeUse (IpeObject' IpeSymbol r)
- | IpePath (IpeObject' Path r)
- _IpePath :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Path r) (f (IpeObject' Path r)) -> p (IpeObject r) (f (IpeObject r))
- _IpeUse :: forall r p f. (Choice p, Applicative f) => p (IpeObject' IpeSymbol r) (f (IpeObject' IpeSymbol r)) -> p (IpeObject r) (f (IpeObject r))
- _IpeGroup :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Group r) (f (IpeObject' Group r)) -> p (IpeObject r) (f (IpeObject r))
- _IpeTextLabel :: forall r p f. (Choice p, Applicative f) => p (IpeObject' TextLabel r) (f (IpeObject' TextLabel r)) -> p (IpeObject r) (f (IpeObject r))
- _IpeMiniPage :: forall r p f. (Choice p, Applicative f) => p (IpeObject' MiniPage r) (f (IpeObject' MiniPage r)) -> p (IpeObject r) (f (IpeObject r))
- _IpeImage :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Image r) (f (IpeObject' Image r)) -> p (IpeObject r) (f (IpeObject r))
- type IpeObject' (g :: Type -> Type) r = g r :+ IpeAttributes g r
- ipeObject' :: ToObject i => i r -> IpeAttributes i r -> IpeObject r
- class ToObject (i :: Type -> Type) where
- mkIpeObject :: IpeObject' i r -> IpeObject r
- newtype Path r = Path (Seq (PathSegment r))
- pathSegments :: forall r r' p f. (Profunctor p, Functor f) => p (Seq (PathSegment r)) (f (Seq (PathSegment r'))) -> p (Path r) (f (Path r'))
- data PathSegment r
- = PolyLineSegment (PolyLine (Point 2 r))
- | PolygonPath (SimplePolygon (Point 2 r))
- | CubicBezierSegment (CubicBezier (Point 2 r))
- | QuadraticBezierSegment (QuadraticBezier (Point 2 r))
- | EllipseSegment (Ellipse r)
- | ArcSegment
- | SplineSegment
- | ClosedSplineSegment
- data IpeSymbol r = Symbol (Point 2 r) Text
- symbolPoint :: forall r r' f. Functor f => (Point 2 r -> f (Point 2 r')) -> IpeSymbol r -> f (IpeSymbol r')
- symbolName :: forall r f. Functor f => (Text -> f Text) -> IpeSymbol r -> f (IpeSymbol r)
- newtype Group r = Group [IpeObject r]
- groupItems :: forall r s f. Functor f => ([IpeObject r] -> f [IpeObject s]) -> Group r -> f (Group s)
- data TextLabel r = Label Text (Point 2 r)
- data MiniPage r = MiniPage Text (Point 2 r) r
- width :: MiniPage t -> t
- data Image r = Image () (Rectangle (Point 2 r))
- imageData :: forall r f. Functor f => (() -> f ()) -> Image r -> f (Image r)
- rect :: forall r r' f. Functor f => (Rectangle (Point 2 r) -> f (Rectangle (Point 2 r'))) -> Image r -> f (Image r')
- type IpeBitmap = Text
- type IpeAttributes (g :: Type -> Type) r = Attributes' r (AttributesOf g)
- type Attributes' r = Attributes (AttrMapSym1 r)
- type family AttributesOf (t :: Type -> Type) :: [AttributeUniverse] where ...
- type family AttrMap r (l :: AttributeUniverse) where ...
- data AttrMapSym1 a6989586621679257806 (b :: TyFun AttributeUniverse Type)
- attributes :: forall g r f. Functor f => (IpeAttributes g r -> f (IpeAttributes g r)) -> IpeObject' g r -> f (IpeObject' g r)
- traverseIpeAttrs :: forall f (g :: Type -> Type) proxy r s. (Applicative f, AllConstrained TraverseIpeAttr (AttributesOf g)) => proxy g -> (r -> f s) -> IpeAttributes g r -> f (IpeAttributes g s)
- commonAttributes :: forall r f. Functor f => (Attributes (AttrMapSym1 r) CommonAttributes -> f (Attributes (AttrMapSym1 r) CommonAttributes)) -> IpeObject r -> f (IpeObject r)
- newtype LayerName = LayerName Text
- layerName :: Iso' LayerName Text
- data View = View [LayerName] LayerName
- layerNames :: Lens' View [LayerName]
- activeLayer :: Lens' View LayerName
- data IpeStyle = IpeStyle (Maybe Text) (Node Text Text)
- styleName :: Lens' IpeStyle (Maybe Text)
- styleData :: Lens' IpeStyle (Node Text Text)
- basicIpeStyle :: IpeStyle
- opacitiesStyle :: IpeStyle
- readIpeStylesheet :: OsPath -> IO (Either ConversionError IpeStyle)
- addStyleSheet :: IpeStyle -> IpeFile r -> IpeFile r
- addStyleSheetFrom :: OsPath -> IpeFile r -> IO (IpeFile r)
- data IpePreamble = IpePreamble (Maybe Text) Text
- encoding :: Lens' IpePreamble (Maybe Text)
- preambleData :: Lens' IpePreamble Text
- class IpeRead t where
- _asPoint :: forall r p f. (Choice p, Applicative f) => p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r))
- _asLineSegment :: forall r p f. (Choice p, Applicative f) => p (LineSegment AnEndPoint (Point 2 r)) (f (LineSegment AnEndPoint (Point 2 r))) -> p (Path r) (f (Path r))
- _asClosedLineSegment :: forall r p f. (Choice p, Applicative f) => p (ClosedLineSegment (Point 2 r)) (f (ClosedLineSegment (Point 2 r))) -> p (Path r) (f (Path r))
- _asRectangle :: (Num r, Ord r) => Prism' (Path r) (Rectangle (Point 2 r))
- _asTriangle :: forall r p f. (Choice p, Applicative f) => p (Triangle (Point 2 r)) (f (Triangle (Point 2 r))) -> p (Path r) (f (Path r))
- _asPolyLine :: forall r p f. (Choice p, Applicative f) => p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r))) -> p (Path r) (f (Path r))
- _asSimplePolygon :: forall r p f. (Choice p, Applicative f) => p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r))) -> p (Path r) (f (Path r))
- _asConvexPolygon :: (Num r, Ord r) => Prism' (Path r) (ConvexPolygon (Point 2 r))
- _withAttrs :: forall r (i :: Type -> Type) g. 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 :: Type -> Type
- defaultFromIpe :: r ~ NumType g => Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r)
- class IpeWrite t where
- class IpeWriteText t where
- ipeWriteText :: t -> Maybe Text
- module Ipe.IpeOut
- module Ipe.Attributes
- module Ipe.Value
- newtype IpeColor r = IpeColor (IpeValue (RGB r))
- named :: Text -> IpeColor r
Ipe Files
A complete ipe file
Instances
preamble :: forall r f. Functor f => (Maybe IpePreamble -> f (Maybe IpePreamble)) -> IpeFile r -> f (IpeFile r) Source #
Lens to access the preamble of an ipe file
styles :: forall r f. Functor f => ([IpeStyle] -> f [IpeStyle]) -> IpeFile r -> f (IpeFile r) Source #
Lens to access the styles of an ipe file
pages :: forall r r' f. Functor f => (NonEmpty (IpePage r) -> f (NonEmpty (IpePage r'))) -> IpeFile r -> f (IpeFile r') Source #
Lens to access the pages of an ipe file
ipeFile :: NonEmpty (IpePage r) -> IpeFile r Source #
Convenience constructor for creating an ipe file without preamble and with the default stylesheet.
singlePageFile :: IpePage r -> IpeFile r Source #
Convenience function to construct an ipe file consisting of a single page.
singlePageFromContent :: [IpeObject r] -> IpeFile r Source #
Create a single page ipe file from a list of IpeObjects
Reading Ipe files
readIpeFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpeFile r)) Source #
Given a file path, tries to read an ipe file.
This function applies all matrices to objects.
readSinglePageFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpePage r)) Source #
Since most Ipe file contain only one page, we provide a shortcut for that as well.
This function applies all matrices, and it makes sure there is at least one layer and view in the page.
readSinglePageFileThrow :: (Coordinate r, Eq r) => OsPath -> IO (IpePage r) Source #
Tries to read a single page file, throws an error when this
fails. See readSinglePageFile
for further details.
readRawIpeFile :: (Coordinate r, Eq r) => OsPath -> IO (Either ConversionError (IpeFile r)) Source #
Given a file path, tries to read an ipe file
type ConversionError = Text Source #
Reading all Geometries from a single page ipe file
readAll :: (HasDefaultFromIpe g, r ~ NumType g) => 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) => OsPath -> 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".
Writing ipe files
writeIpeFile :: IpeWriteText r => OsPath -> IpeFile r -> IO () Source #
Write an IpeFiele to file.
writeIpeFile' :: IpeWrite t => t -> OsPath -> IO () Source #
Convert to ipe XML and write the output to a file.
writeIpePage :: IpeWriteText r => OsPath -> IpePage r -> IO () Source #
Creates a single page ipe file with the given page
printAsIpeSelection :: IpeWrite t => t -> IO () Source #
Convert the input to ipeXml, and prints it to standard out in such a way that the copied text can be pasted into ipe as a geometry object.
toIpeSelectionXML :: IpeWrite t => t -> Maybe ByteString Source #
Convert input into an ipe selection.
Ipe Pages
An IpePage is essentially a Group, together with a list of layers and a list of views.
Instances
Generic (IpePage r) Source # | |||||
Defined in Ipe.Types
| |||||
Show r => Show (IpePage r) Source # | |||||
Eq r => Eq (IpePage r) Source # | |||||
(Coordinate r, Eq r) => IpeRead (IpePage r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (IpePage r) Source # | |||||
type Rep (IpePage r) Source # | |||||
Defined in Ipe.Types type Rep (IpePage r) = D1 ('MetaData "IpePage" "Ipe.Types" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "IpePage" 'PrefixI 'True) (S1 ('MetaSel ('Just "_layers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LayerName]) :*: (S1 ('MetaSel ('Just "_views") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [View]) :*: S1 ('MetaSel ('Just "_content") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [IpeObject r])))) |
layers :: forall r f. Functor f => ([LayerName] -> f [LayerName]) -> IpePage r -> f (IpePage r) Source #
Lens to access the layers of an ipe page
views :: forall r f. Functor f => ([View] -> f [View]) -> IpePage r -> f (IpePage r) Source #
Lens to access the views of an ipe page
content :: forall r r' f. Functor f => ([IpeObject r] -> f [IpeObject r']) -> IpePage r -> f (IpePage r') Source #
Lens to access the content of an ipe page
fromContent :: [IpeObject r] -> IpePage r Source #
Creates a simple page with a single view.
onLayer :: LayerName -> Getting (Endo [IpeObject r]) [IpeObject r] (IpeObject r) Source #
This allows you to filter the objects on some layer.
>>>
let page = IpePage [] [] []
>>>
page^..content.onLayer "myLayer"
[]
contentInView :: Word -> Getter (IpePage r) [IpeObject r] Source #
Gets all objects that are visible in the given view.
Note that views are indexed starting from 0. If the page does not have any explicit view definitions, this function returns an empty list.
>>>
let page = IpePage [] [] []
>>>
page^.contentInView 0
[]
withDefaults :: IpePage r -> IpePage r Source #
Makes sure that the page has at least one layer and at least one view, essentially matching the behaviour of ipe. In particular,
- if the page does not have any layers, it creates a layer named "alpha", and
- if the page does not have any views, it creates a view in which all layers are visible.
Content: Ipe Objects
IpeGroup (IpeObject' Group r) | |
IpeImage (IpeObject' Image r) | |
IpeTextLabel (IpeObject' TextLabel r) | |
IpeMiniPage (IpeObject' MiniPage r) | |
IpeUse (IpeObject' IpeSymbol r) | |
IpePath (IpeObject' Path r) |
Instances
Functor IpeObject Source # | |||||
Foldable IpeObject Source # | |||||
Defined in Ipe.Content fold :: Monoid m => IpeObject m -> m # foldMap :: Monoid m => (a -> m) -> IpeObject a -> m # foldMap' :: Monoid m => (a -> m) -> IpeObject a -> m # foldr :: (a -> b -> b) -> b -> IpeObject a -> b # foldr' :: (a -> b -> b) -> b -> IpeObject a -> b # foldl :: (b -> a -> b) -> b -> IpeObject a -> b # foldl' :: (b -> a -> b) -> b -> IpeObject a -> b # foldr1 :: (a -> a -> a) -> IpeObject a -> a # foldl1 :: (a -> a -> a) -> IpeObject a -> a # toList :: IpeObject a -> [a] # length :: IpeObject a -> Int # elem :: Eq a => a -> IpeObject a -> Bool # maximum :: Ord a => IpeObject a -> a # minimum :: Ord a => IpeObject a -> a # | |||||
Traversable IpeObject Source # | |||||
Generic (IpeObject r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (IpeObject r) Source # | |||||
Eq r => Eq (IpeObject r) Source # | |||||
(Coordinate r, Fractional r, Eq r) => IpeRead (IpeObject r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (IpeObject r) Source # | |||||
Fractional r => IsTransformable (IpeObject r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (IpeObject r)) (NumType (IpeObject r)) -> IpeObject r -> IpeObject r | |||||
type Rep (IpeObject r) Source # | |||||
Defined in Ipe.Content type Rep (IpeObject r) = D1 ('MetaData "IpeObject" "Ipe.Content" "hgeometry-1.0.0.0-inplace-ipe" 'False) ((C1 ('MetaCons "IpeGroup" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' Group r))) :+: (C1 ('MetaCons "IpeImage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' Image r))) :+: C1 ('MetaCons "IpeTextLabel" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' TextLabel r))))) :+: (C1 ('MetaCons "IpeMiniPage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' MiniPage r))) :+: (C1 ('MetaCons "IpeUse" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' IpeSymbol r))) :+: C1 ('MetaCons "IpePath" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IpeObject' Path r)))))) | |||||
type Dimension (IpeObject r) Source # | |||||
Defined in Ipe.Content type Dimension (IpeObject r) = 2 | |||||
type NumType (IpeObject r) Source # | |||||
Defined in Ipe.Content type NumType (IpeObject r) = r |
_IpePath :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Path r) (f (IpeObject' Path r)) -> p (IpeObject r) (f (IpeObject r)) Source #
_IpeUse :: forall r p f. (Choice p, Applicative f) => p (IpeObject' IpeSymbol r) (f (IpeObject' IpeSymbol r)) -> p (IpeObject r) (f (IpeObject r)) Source #
_IpeGroup :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Group r) (f (IpeObject' Group r)) -> p (IpeObject r) (f (IpeObject r)) Source #
_IpeTextLabel :: forall r p f. (Choice p, Applicative f) => p (IpeObject' TextLabel r) (f (IpeObject' TextLabel r)) -> p (IpeObject r) (f (IpeObject r)) Source #
_IpeMiniPage :: forall r p f. (Choice p, Applicative f) => p (IpeObject' MiniPage r) (f (IpeObject' MiniPage r)) -> p (IpeObject r) (f (IpeObject r)) Source #
_IpeImage :: forall r p f. (Choice p, Applicative f) => p (IpeObject' Image r) (f (IpeObject' Image r)) -> p (IpeObject r) (f (IpeObject r)) Source #
type IpeObject' (g :: Type -> Type) r = g r :+ IpeAttributes g r Source #
An IpeObject' is essentially the oject ogether with its attributes
ipeObject' :: ToObject i => i r -> IpeAttributes i r -> IpeObject r Source #
Shorthand for constructing ipeObjects
class ToObject (i :: Type -> Type) where Source #
mkIpeObject :: IpeObject' i r -> IpeObject r Source #
Instances
ToObject Group Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' Group r -> IpeObject r Source # | |
ToObject Image Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' Image r -> IpeObject r Source # | |
ToObject IpeSymbol Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' IpeSymbol r -> IpeObject r Source # | |
ToObject MiniPage Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' MiniPage r -> IpeObject r Source # | |
ToObject TextLabel Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' TextLabel r -> IpeObject r Source # | |
ToObject Path Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' Path r -> IpeObject r Source # |
Specific Ipe-Objects
A path is a non-empty sequence of PathSegments.
Path (Seq (PathSegment r)) |
Instances
Functor Path Source # | |
Foldable Path Source # | |
Defined in Ipe.Path fold :: Monoid m => Path m -> m # foldMap :: Monoid m => (a -> m) -> Path a -> m # foldMap' :: Monoid m => (a -> m) -> Path a -> m # foldr :: (a -> b -> b) -> b -> Path a -> b # foldr' :: (a -> b -> b) -> b -> Path a -> b # foldl :: (b -> a -> b) -> b -> Path a -> b # foldl' :: (b -> a -> b) -> b -> Path a -> b # foldr1 :: (a -> a -> a) -> Path a -> a # foldl1 :: (a -> a -> a) -> Path a -> a # elem :: Eq a => a -> Path a -> Bool # maximum :: Ord a => Path a -> a # | |
Traversable Path Source # | |
ToObject Path Source # | |
Defined in Ipe.Content mkIpeObject :: IpeObject' Path r -> IpeObject r Source # | |
Semigroup (Path r) Source # | |
Generic (Path r) Source # | |
Defined in Ipe.Path | |
Show r => Show (Path r) Source # | |
Eq r => Eq (Path r) Source # | |
(Coordinate r, Fractional r, Eq r) => IpeRead (Path r) Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Fractional r, Eq r) => IpeReadText (Path r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (Path r) Source # | |
IpeWriteText r => IpeWrite (Path r) Source # | |
IpeWriteText r => IpeWriteText (Path r) Source # | |
Defined in Ipe.Writer | |
Fractional r => IsTransformable (Path r) Source # | |
type Rep (Path r) Source # | |
Defined in Ipe.Path type Rep (Path r) = D1 ('MetaData "Path" "Ipe.Path" "hgeometry-1.0.0.0-inplace-ipe" 'True) (C1 ('MetaCons "Path" 'PrefixI 'True) (S1 ('MetaSel ('Just "_pathSegments") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Seq (PathSegment r))))) | |
type Dimension (Path r) Source # | |
type NumType (Path r) Source # | |
pathSegments :: forall r r' p f. (Profunctor p, Functor f) => p (Seq (PathSegment r)) (f (Seq (PathSegment r'))) -> p (Path r) (f (Path r')) Source #
Lens/Iso to access the sequcne of segments of the path
data PathSegment r Source #
Paths
Paths consist of Path Segments. PathSegments come in the following forms:
PolyLineSegment (PolyLine (Point 2 r)) | |
PolygonPath (SimplePolygon (Point 2 r)) | |
CubicBezierSegment (CubicBezier (Point 2 r)) | |
QuadraticBezierSegment (QuadraticBezier (Point 2 r)) | |
EllipseSegment (Ellipse r) | |
ArcSegment | |
SplineSegment | |
ClosedSplineSegment |
Instances
Functor PathSegment Source # | |
Defined in Ipe.Path fmap :: (a -> b) -> PathSegment a -> PathSegment b # (<$) :: a -> PathSegment b -> PathSegment a # | |
Foldable PathSegment Source # | |
Defined in Ipe.Path fold :: Monoid m => PathSegment m -> m # foldMap :: Monoid m => (a -> m) -> PathSegment a -> m # foldMap' :: Monoid m => (a -> m) -> PathSegment a -> m # foldr :: (a -> b -> b) -> b -> PathSegment a -> b # foldr' :: (a -> b -> b) -> b -> PathSegment a -> b # foldl :: (b -> a -> b) -> b -> PathSegment a -> b # foldl' :: (b -> a -> b) -> b -> PathSegment a -> b # foldr1 :: (a -> a -> a) -> PathSegment a -> a # foldl1 :: (a -> a -> a) -> PathSegment a -> a # toList :: PathSegment a -> [a] # null :: PathSegment a -> Bool # length :: PathSegment a -> Int # elem :: Eq a => a -> PathSegment a -> Bool # maximum :: Ord a => PathSegment a -> a # minimum :: Ord a => PathSegment a -> a # sum :: Num a => PathSegment a -> a # product :: Num a => PathSegment a -> a # | |
Traversable PathSegment Source # | |
Defined in Ipe.Path traverse :: Applicative f => (a -> f b) -> PathSegment a -> f (PathSegment b) # sequenceA :: Applicative f => PathSegment (f a) -> f (PathSegment a) # mapM :: Monad m => (a -> m b) -> PathSegment a -> m (PathSegment b) # sequence :: Monad m => PathSegment (m a) -> m (PathSegment a) # | |
Show r => Show (PathSegment r) Source # | |
Defined in Ipe.Path showsPrec :: Int -> PathSegment r -> ShowS # show :: PathSegment r -> String # showList :: [PathSegment r] -> ShowS # | |
Eq r => Eq (PathSegment r) Source # | |
Defined in Ipe.Path (==) :: PathSegment r -> PathSegment r -> Bool # (/=) :: PathSegment r -> PathSegment r -> Bool # | |
(Coordinate r, Fractional r, Eq r) => IpeReadText (NonEmpty (PathSegment r)) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (NonEmpty (PathSegment r)) Source # | |
IpeWriteText r => IpeWriteText (PathSegment r) Source # | |
Defined in Ipe.Writer ipeWriteText :: PathSegment r -> Maybe Text Source # | |
Fractional r => IsTransformable (PathSegment r) Source # | |
Defined in Ipe.Path transformBy :: Transformation (Dimension (PathSegment r)) (NumType (PathSegment r)) -> PathSegment r -> PathSegment r | |
type Dimension (PathSegment r) Source # | |
Defined in Ipe.Path type Dimension (PathSegment r) = 2 | |
type NumType (PathSegment r) Source # | |
Defined in Ipe.Path type NumType (PathSegment r) = r |
Ipe Symbols, i.e. Points
A symbol (point) in ipe
Instances
Functor IpeSymbol Source # | |||||
Foldable IpeSymbol Source # | |||||
Defined in Ipe.Content fold :: Monoid m => IpeSymbol m -> m # foldMap :: Monoid m => (a -> m) -> IpeSymbol a -> m # foldMap' :: Monoid m => (a -> m) -> IpeSymbol a -> m # foldr :: (a -> b -> b) -> b -> IpeSymbol a -> b # foldr' :: (a -> b -> b) -> b -> IpeSymbol a -> b # foldl :: (b -> a -> b) -> b -> IpeSymbol a -> b # foldl' :: (b -> a -> b) -> b -> IpeSymbol a -> b # foldr1 :: (a -> a -> a) -> IpeSymbol a -> a # foldl1 :: (a -> a -> a) -> IpeSymbol a -> a # toList :: IpeSymbol a -> [a] # length :: IpeSymbol a -> Int # elem :: Eq a => a -> IpeSymbol a -> Bool # maximum :: Ord a => IpeSymbol a -> a # minimum :: Ord a => IpeSymbol a -> a # | |||||
Traversable IpeSymbol Source # | |||||
ToObject IpeSymbol Source # | |||||
Defined in Ipe.Content mkIpeObject :: IpeObject' IpeSymbol r -> IpeObject r Source # | |||||
Generic (IpeSymbol r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (IpeSymbol r) Source # | |||||
Eq r => Eq (IpeSymbol r) Source # | |||||
Ord r => Ord (IpeSymbol r) Source # | |||||
Coordinate r => IpeRead (IpeSymbol r) Source # | Ipe read instances | ||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (IpeSymbol r) Source # | |||||
Fractional r => IsTransformable (IpeSymbol r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (IpeSymbol r)) (NumType (IpeSymbol r)) -> IpeSymbol r -> IpeSymbol r | |||||
type Rep (IpeSymbol r) Source # | |||||
Defined in Ipe.Content type Rep (IpeSymbol r) = D1 ('MetaData "IpeSymbol" "Ipe.Content" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "Symbol" 'PrefixI 'True) (S1 ('MetaSel ('Just "_symbolPoint") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Point 2 r)) :*: S1 ('MetaSel ('Just "_symbolName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) | |||||
type Dimension (IpeSymbol r) Source # | |||||
Defined in Ipe.Content type Dimension (IpeSymbol r) = 2 | |||||
type NumType (IpeSymbol r) Source # | |||||
Defined in Ipe.Content type NumType (IpeSymbol r) = r |
symbolPoint :: forall r r' f. Functor f => (Point 2 r -> f (Point 2 r')) -> IpeSymbol r -> f (IpeSymbol r') Source #
Lens to access the position of the symbol
symbolName :: forall r f. Functor f => (Text -> f Text) -> IpeSymbol r -> f (IpeSymbol r) Source #
Lens to access the name of the symbol
Groups and Objects
Group Attributes
A group is essentially a list of IpeObjects.
Instances
Functor Group Source # | |||||
Foldable Group Source # | |||||
Defined in Ipe.Content fold :: Monoid m => Group m -> m # foldMap :: Monoid m => (a -> m) -> Group a -> m # foldMap' :: Monoid m => (a -> m) -> Group a -> m # foldr :: (a -> b -> b) -> b -> Group a -> b # foldr' :: (a -> b -> b) -> b -> Group a -> b # foldl :: (b -> a -> b) -> b -> Group a -> b # foldl' :: (b -> a -> b) -> b -> Group a -> b # foldr1 :: (a -> a -> a) -> Group a -> a # foldl1 :: (a -> a -> a) -> Group a -> a # elem :: Eq a => a -> Group a -> Bool # maximum :: Ord a => Group a -> a # minimum :: Ord a => Group a -> a # | |||||
Traversable Group Source # | |||||
ToObject Group Source # | |||||
Defined in Ipe.Content mkIpeObject :: IpeObject' Group r -> IpeObject r Source # | |||||
Generic (Group r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (Group r) Source # | |||||
Eq r => Eq (Group r) Source # | |||||
HasDefaultIpeOut (Group r) Source # | |||||
Defined in Ipe.IpeOut
| |||||
(Coordinate r, Eq r) => IpeRead (Group r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (Group r) Source # | |||||
Fractional r => IsTransformable (Group r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (Group r)) (NumType (Group r)) -> Group r -> Group r | |||||
type Rep (Group r) Source # | |||||
Defined in Ipe.Content | |||||
type DefaultIpeOut (Group r) Source # | |||||
Defined in Ipe.IpeOut | |||||
type Dimension (Group r) Source # | |||||
Defined in Ipe.Content type Dimension (Group r) = 2 | |||||
type NumType (Group r) Source # | |||||
Defined in Ipe.Content type NumType (Group r) = r |
groupItems :: forall r s f. Functor f => ([IpeObject r] -> f [IpeObject s]) -> Group r -> f (Group s) Source #
Text Objects
A text label
Instances
Functor TextLabel Source # | |||||
Foldable TextLabel Source # | |||||
Defined in Ipe.Content fold :: Monoid m => TextLabel m -> m # foldMap :: Monoid m => (a -> m) -> TextLabel a -> m # foldMap' :: Monoid m => (a -> m) -> TextLabel a -> m # foldr :: (a -> b -> b) -> b -> TextLabel a -> b # foldr' :: (a -> b -> b) -> b -> TextLabel a -> b # foldl :: (b -> a -> b) -> b -> TextLabel a -> b # foldl' :: (b -> a -> b) -> b -> TextLabel a -> b # foldr1 :: (a -> a -> a) -> TextLabel a -> a # foldl1 :: (a -> a -> a) -> TextLabel a -> a # toList :: TextLabel a -> [a] # length :: TextLabel a -> Int # elem :: Eq a => a -> TextLabel a -> Bool # maximum :: Ord a => TextLabel a -> a # minimum :: Ord a => TextLabel a -> a # | |||||
Traversable TextLabel Source # | |||||
ToObject TextLabel Source # | |||||
Defined in Ipe.Content mkIpeObject :: IpeObject' TextLabel r -> IpeObject r Source # | |||||
Generic (TextLabel r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (TextLabel r) Source # | |||||
Eq r => Eq (TextLabel r) Source # | |||||
Ord r => Ord (TextLabel r) Source # | |||||
Coordinate r => IpeRead (TextLabel r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (TextLabel r) Source # | |||||
Fractional r => IsTransformable (TextLabel r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (TextLabel r)) (NumType (TextLabel r)) -> TextLabel r -> TextLabel r | |||||
type Rep (TextLabel r) Source # | |||||
Defined in Ipe.Content type Rep (TextLabel r) = D1 ('MetaData "TextLabel" "Ipe.Content" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "Label" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Point 2 r)))) | |||||
type Dimension (TextLabel r) Source # | |||||
Defined in Ipe.Content type Dimension (TextLabel r) = 2 | |||||
type NumType (TextLabel r) Source # | |||||
Defined in Ipe.Content type NumType (TextLabel r) = r |
A Minipage
Instances
Functor MiniPage Source # | |||||
Foldable MiniPage Source # | |||||
Defined in Ipe.Content fold :: Monoid m => MiniPage m -> m # foldMap :: Monoid m => (a -> m) -> MiniPage a -> m # foldMap' :: Monoid m => (a -> m) -> MiniPage a -> m # foldr :: (a -> b -> b) -> b -> MiniPage a -> b # foldr' :: (a -> b -> b) -> b -> MiniPage a -> b # foldl :: (b -> a -> b) -> b -> MiniPage a -> b # foldl' :: (b -> a -> b) -> b -> MiniPage a -> b # foldr1 :: (a -> a -> a) -> MiniPage a -> a # foldl1 :: (a -> a -> a) -> MiniPage a -> a # elem :: Eq a => a -> MiniPage a -> Bool # maximum :: Ord a => MiniPage a -> a # minimum :: Ord a => MiniPage a -> a # | |||||
Traversable MiniPage Source # | |||||
ToObject MiniPage Source # | |||||
Defined in Ipe.Content mkIpeObject :: IpeObject' MiniPage r -> IpeObject r Source # | |||||
Generic (MiniPage r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (MiniPage r) Source # | |||||
Eq r => Eq (MiniPage r) Source # | |||||
Ord r => Ord (MiniPage r) Source # | |||||
Coordinate r => IpeRead (MiniPage r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (MiniPage r) Source # | |||||
Fractional r => IsTransformable (MiniPage r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (MiniPage r)) (NumType (MiniPage r)) -> MiniPage r -> MiniPage r | |||||
type Rep (MiniPage r) Source # | |||||
Defined in Ipe.Content type Rep (MiniPage r) = D1 ('MetaData "MiniPage" "Ipe.Content" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "MiniPage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Point 2 r)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 r)))) | |||||
type Dimension (MiniPage r) Source # | |||||
Defined in Ipe.Content type Dimension (MiniPage r) = 2 | |||||
type NumType (MiniPage r) Source # | |||||
Defined in Ipe.Content type NumType (MiniPage r) = r |
Image Objects
bitmap image objects in Ipe
Instances
Functor Image Source # | |||||
Foldable Image Source # | |||||
Defined in Ipe.Content fold :: Monoid m => Image m -> m # foldMap :: Monoid m => (a -> m) -> Image a -> m # foldMap' :: Monoid m => (a -> m) -> Image a -> m # foldr :: (a -> b -> b) -> b -> Image a -> b # foldr' :: (a -> b -> b) -> b -> Image a -> b # foldl :: (b -> a -> b) -> b -> Image a -> b # foldl' :: (b -> a -> b) -> b -> Image a -> b # foldr1 :: (a -> a -> a) -> Image a -> a # foldl1 :: (a -> a -> a) -> Image a -> a # elem :: Eq a => a -> Image a -> Bool # maximum :: Ord a => Image a -> a # minimum :: Ord a => Image a -> a # | |||||
Traversable Image Source # | |||||
ToObject Image Source # | |||||
Defined in Ipe.Content mkIpeObject :: IpeObject' Image r -> IpeObject r Source # | |||||
Generic (Image r) Source # | |||||
Defined in Ipe.Content
| |||||
Show r => Show (Image r) Source # | |||||
Eq r => Eq (Image r) Source # | |||||
Ord r => Ord (Image r) Source # | |||||
Coordinate r => IpeRead (Image r) Source # | |||||
Defined in Ipe.Reader | |||||
IpeWriteText r => IpeWrite (Image r) Source # | |||||
Fractional r => IsTransformable (Image r) Source # | |||||
Defined in Ipe.Content transformBy :: Transformation (Dimension (Image r)) (NumType (Image r)) -> Image r -> Image r | |||||
type Rep (Image r) Source # | |||||
Defined in Ipe.Content type Rep (Image r) = D1 ('MetaData "Image" "Ipe.Content" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "Image" 'PrefixI 'True) (S1 ('MetaSel ('Just "_imageData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ()) :*: S1 ('MetaSel ('Just "_rect") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Rectangle (Point 2 r))))) | |||||
type Dimension (Image r) Source # | |||||
Defined in Ipe.Content type Dimension (Image r) = 2 | |||||
type NumType (Image r) Source # | |||||
Defined in Ipe.Content type NumType (Image r) = r |
imageData :: forall r f. Functor f => (() -> f ()) -> Image r -> f (Image r) Source #
Lens to access the image data
rect :: forall r r' f. Functor f => (Rectangle (Point 2 r) -> f (Rectangle (Point 2 r'))) -> Image r -> f (Image r') Source #
Lens to access the rectangle of the image
Attributes
type IpeAttributes (g :: Type -> Type) r = Attributes' r (AttributesOf g) Source #
type Attributes' r = Attributes (AttrMapSym1 r) Source #
Attributes' :: Type -> [AttributeUniverse] -> Type
type family AttributesOf (t :: Type -> Type) :: [AttributeUniverse] where ... Source #
type family AttrMap r (l :: AttributeUniverse) where ... Source #
The mapping between the labels of the the attributes and the types of the
attributes with these labels. For example, the Matrix
label/attribute should
have a value of type 'Matrix 3 3 r'.
AttrMap r 'Layer = LayerName | |
AttrMap r 'Matrix = Matrix 3 3 r | |
AttrMap r 'Pin = PinType | |
AttrMap r 'Transformations = TransformationTypes | |
AttrMap r 'Stroke = IpeColor r | |
AttrMap r 'Pen = IpePen r | |
AttrMap r 'Fill = IpeColor r | |
AttrMap r 'Size = IpeSize r | |
AttrMap r 'Dash = IpeDash r | |
AttrMap r 'LineCap = Int | |
AttrMap r 'LineJoin = Int | |
AttrMap r 'FillRule = FillType | |
AttrMap r 'Arrow = IpeArrow r | |
AttrMap r 'RArrow = IpeArrow r | |
AttrMap r 'StrokeOpacity = IpeOpacity | |
AttrMap r 'Opacity = IpeOpacity | |
AttrMap r 'Tiling = IpeTiling | |
AttrMap r 'Gradient = IpeGradient | |
AttrMap r 'Width = TextSizeUnit r | |
AttrMap r 'Height = TextSizeUnit r | |
AttrMap r 'Depth = TextSizeUnit r | |
AttrMap r 'VAlign = VerticalAlignment | |
AttrMap r 'HAlign = HorizontalAlignment | |
AttrMap r 'Style = TeXStyle | |
AttrMap r 'Clip = Path r |
data AttrMapSym1 a6989586621679257806 (b :: TyFun AttributeUniverse Type) Source #
Instances
SuppressUnusedWarnings (AttrMapSym1 a6989586621679257806 :: TyFun AttributeUniverse Type -> Type) Source # | |
Defined in Ipe.Content suppressUnusedWarnings :: () Source # | |
type Apply (AttrMapSym1 a6989586621679257806 :: TyFun AttributeUniverse Type -> Type) (a6989586621679257807 :: AttributeUniverse) Source # | |
Defined in Ipe.Content type Apply (AttrMapSym1 a6989586621679257806 :: TyFun AttributeUniverse Type -> Type) (a6989586621679257807 :: AttributeUniverse) = AttrMap a6989586621679257806 a6989586621679257807 |
attributes :: forall g r f. Functor f => (IpeAttributes g r -> f (IpeAttributes g r)) -> IpeObject' g r -> f (IpeObject' g r) Source #
traverseIpeAttrs :: forall f (g :: Type -> Type) proxy r s. (Applicative f, AllConstrained TraverseIpeAttr (AttributesOf g)) => proxy g -> (r -> f s) -> IpeAttributes g r -> f (IpeAttributes g s) Source #
traverse for ipe attributes
commonAttributes :: forall r f. Functor f => (Attributes (AttrMapSym1 r) CommonAttributes -> f (Attributes (AttrMapSym1 r) CommonAttributes)) -> IpeObject r -> f (IpeObject r) Source #
Layers and Views
Defines an Layer in Ipe.
Instances
IsString LayerName Source # | |
Defined in Ipe.Layer fromString :: String -> LayerName # | |
Read LayerName Source # | |
Show LayerName Source # | |
Eq LayerName Source # | |
Ord LayerName Source # | |
Defined in Ipe.Layer | |
IpeRead LayerName Source # | |
Defined in Ipe.Reader | |
IpeReadText LayerName Source # | |
Defined in Ipe.Reader | |
IpeWrite LayerName Source # | |
IpeWriteText LayerName Source # | |
Defined in Ipe.Writer |
The definition of a view make active layer into an index ?
Instances
Generic View Source # | |||||
Defined in Ipe.Types
| |||||
Show View Source # | |||||
Eq View Source # | |||||
Ord View Source # | |||||
IpeRead View Source # | |||||
Defined in Ipe.Reader | |||||
IpeWrite View Source # | |||||
type Rep View Source # | |||||
Defined in Ipe.Types type Rep View = D1 ('MetaData "View" "Ipe.Types" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "View" 'PrefixI 'True) (S1 ('MetaSel ('Just "_layerNames") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LayerName]) :*: S1 ('MetaSel ('Just "_activeLayer") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LayerName))) |
Ipe Syles and Preamble
for now we pretty much ignore these
Instances
Generic IpeStyle Source # | |||||
Defined in Ipe.Types
| |||||
Show IpeStyle Source # | |||||
Eq IpeStyle Source # | |||||
IpeRead IpeStyle Source # | |||||
Defined in Ipe.Reader | |||||
IpeWrite IpeStyle Source # | |||||
type Rep IpeStyle Source # | |||||
Defined in Ipe.Types type Rep IpeStyle = D1 ('MetaData "IpeStyle" "Ipe.Types" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "IpeStyle" 'PrefixI 'True) (S1 ('MetaSel ('Just "_styleName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "_styleData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node Text Text)))) |
basicIpeStyle :: IpeStyle Source #
The "basic" ipe stylesheet
opacitiesStyle :: IpeStyle Source #
A stylesheet with some convenient predefined opacities. In particular the opacities "10%","20%",..,"90%".
readIpeStylesheet :: OsPath -> IO (Either ConversionError IpeStyle) Source #
Reads an Ipe stylesheet from Disk.
addStyleSheet :: IpeStyle -> IpeFile r -> IpeFile r Source #
Adds a stylesheet to the ipe file. This will be the first stylesheet, i.e. it has priority over all previously imported stylesheets.
addStyleSheetFrom :: OsPath -> IpeFile r -> IO (IpeFile r) Source #
Given a path to a stylesheet, add it to the ipe file with the highest priority. Throws an error when this fails.
data IpePreamble Source #
The maybe string is the encoding
Instances
Generic IpePreamble Source # | |||||
Defined in Ipe.Types
from :: IpePreamble -> Rep IpePreamble x # to :: Rep IpePreamble x -> IpePreamble # | |||||
Read IpePreamble Source # | |||||
Defined in Ipe.Types readsPrec :: Int -> ReadS IpePreamble # readList :: ReadS [IpePreamble] # readPrec :: ReadPrec IpePreamble # readListPrec :: ReadPrec [IpePreamble] # | |||||
Show IpePreamble Source # | |||||
Defined in Ipe.Types showsPrec :: Int -> IpePreamble -> ShowS # show :: IpePreamble -> String # showList :: [IpePreamble] -> ShowS # | |||||
Eq IpePreamble Source # | |||||
Defined in Ipe.Types (==) :: IpePreamble -> IpePreamble -> Bool # (/=) :: IpePreamble -> IpePreamble -> Bool # | |||||
Ord IpePreamble Source # | |||||
Defined in Ipe.Types compare :: IpePreamble -> IpePreamble -> Ordering # (<) :: IpePreamble -> IpePreamble -> Bool # (<=) :: IpePreamble -> IpePreamble -> Bool # (>) :: IpePreamble -> IpePreamble -> Bool # (>=) :: IpePreamble -> IpePreamble -> Bool # max :: IpePreamble -> IpePreamble -> IpePreamble # min :: IpePreamble -> IpePreamble -> IpePreamble # | |||||
IpeWrite IpePreamble Source # | |||||
Defined in Ipe.Writer | |||||
type Rep IpePreamble Source # | |||||
Defined in Ipe.Types type Rep IpePreamble = D1 ('MetaData "IpePreamble" "Ipe.Types" "hgeometry-1.0.0.0-inplace-ipe" 'False) (C1 ('MetaCons "IpePreamble" 'PrefixI 'True) (S1 ('MetaSel ('Just "_encoding") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "_preambleData") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) |
preambleData :: Lens' IpePreamble Text Source #
Lens to access the preambleData
Reading Geometries *From* Ipe
class IpeRead t where Source #
Reading an ipe lement from Xml
Instances
IpeRead LayerName Source # | |
Defined in Ipe.Reader | |
IpeRead IpeStyle Source # | |
Defined in Ipe.Reader | |
IpeRead View Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Eq r) => IpeRead (Group r) Source # | |
Defined in Ipe.Reader | |
Coordinate r => IpeRead (Image r) Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Fractional r, Eq r) => IpeRead (IpeObject r) Source # | |
Defined in Ipe.Reader | |
Coordinate r => IpeRead (IpeSymbol r) Source # | Ipe read instances |
Defined in Ipe.Reader | |
Coordinate r => IpeRead (MiniPage r) Source # | |
Defined in Ipe.Reader | |
Coordinate r => IpeRead (TextLabel r) Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Fractional r, Eq r) => IpeRead (Path r) Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Eq r) => IpeRead (IpeFile r) Source # | |
Defined in Ipe.Reader | |
(Coordinate r, Eq r) => IpeRead (IpePage r) Source # | |
Defined in Ipe.Reader |
Converting *from* IpeObjects
_asPoint :: forall r p f. (Choice p, Applicative f) => p (Point 2 r) (f (Point 2 r)) -> p (IpeSymbol r) (f (IpeSymbol r)) Source #
Extracts the point from a Symbol. When creating a symbol this creates a disk that supports a stroke color.
_asLineSegment :: forall r p f. (Choice p, Applicative f) => p (LineSegment AnEndPoint (Point 2 r)) (f (LineSegment AnEndPoint (Point 2 r))) -> p (Path r) (f (Path 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.
_asClosedLineSegment :: forall r p f. (Choice p, Applicative f) => p (ClosedLineSegment (Point 2 r)) (f (ClosedLineSegment (Point 2 r))) -> p (Path r) (f (Path 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.
_asRectangle :: (Num r, Ord r) => Prism' (Path r) (Rectangle (Point 2 r)) Source #
Tries to convert a path into a rectangle.
_asTriangle :: forall r p f. (Choice p, Applicative f) => p (Triangle (Point 2 r)) (f (Triangle (Point 2 r))) -> p (Path r) (f (Path r)) Source #
Convert to a triangle
_asPolyLine :: forall r p f. (Choice p, Applicative f) => p (PolyLine (Point 2 r)) (f (PolyLine (Point 2 r))) -> p (Path r) (f (Path r)) Source #
Convert to a polyline. Ignores all non-polyline parts
>>>
testPath ^? _asPolyLine
Just (PolyLine [Point2 0 0,Point2 10 10,Point2 200 100])
_asSimplePolygon :: forall r p f. (Choice p, Applicative f) => p (SimplePolygon (Point 2 r)) (f (SimplePolygon (Point 2 r))) -> p (Path r) (f (Path r)) Source #
Convert to a simple polygon
_asConvexPolygon :: (Num r, Ord r) => Prism' (Path r) (ConvexPolygon (Point 2 r)) Source #
Convert to a convex polygon
Dealing with Attributes
_withAttrs :: forall r (i :: Type -> Type) g. 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 [Point2 0 0,Point2 10 10,Point2 200 100] :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "red"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})
Default readers
class HasDefaultFromIpe g where Source #
type DefaultFromIpe g :: Type -> Type Source #
defaultFromIpe :: r ~ NumType g => Prism' (IpeObject r) (g :+ IpeAttributes (DefaultFromIpe g) r) Source #
Instances
HasDefaultFromIpe (PolyLine (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (PolyLine (Point 2 r)) => Prism' (IpeObject r0) (PolyLine (Point 2 r) :+ IpeAttributes (DefaultFromIpe (PolyLine (Point 2 r))) r0) Source # | |||||
HasDefaultFromIpe (SimplePolygon (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (SimplePolygon (Point 2 r)) => Prism' (IpeObject r0) (SimplePolygon (Point 2 r) :+ IpeAttributes (DefaultFromIpe (SimplePolygon (Point 2 r))) r0) Source # | |||||
(Radical r, Eq r) => HasDefaultFromIpe (Circle (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (Circle (Point 2 r)) => Prism' (IpeObject r0) (Circle (Point 2 r) :+ IpeAttributes (DefaultFromIpe (Circle (Point 2 r))) r0) Source # | |||||
(Radical r, Eq r) => HasDefaultFromIpe (Disk (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (Disk (Point 2 r)) => Prism' (IpeObject r0) (Disk (Point 2 r) :+ IpeAttributes (DefaultFromIpe (Disk (Point 2 r))) r0) Source # | |||||
(Num r, Ord r) => HasDefaultFromIpe (Rectangle (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (Rectangle (Point 2 r)) => Prism' (IpeObject r0) (Rectangle (Point 2 r) :+ IpeAttributes (DefaultFromIpe (Rectangle (Point 2 r))) r0) Source # | |||||
HasDefaultFromIpe (Ellipse r) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (Ellipse r) => Prism' (IpeObject r0) (Ellipse r :+ IpeAttributes (DefaultFromIpe (Ellipse r)) r0) Source # | |||||
HasDefaultFromIpe (ClosedLineSegment (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (ClosedLineSegment (Point 2 r)) => Prism' (IpeObject r0) (ClosedLineSegment (Point 2 r) :+ IpeAttributes (DefaultFromIpe (ClosedLineSegment (Point 2 r))) r0) Source # | |||||
HasDefaultFromIpe (LineSegment AnEndPoint (Point 2 r)) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (LineSegment AnEndPoint (Point 2 r)) => Prism' (IpeObject r0) (LineSegment AnEndPoint (Point 2 r) :+ IpeAttributes (DefaultFromIpe (LineSegment AnEndPoint (Point 2 r))) r0) Source # | |||||
HasDefaultFromIpe (Point 2 r) Source # | |||||
Defined in Ipe.FromIpe
defaultFromIpe :: r0 ~ NumType (Point 2 r) => Prism' (IpeObject r0) (Point 2 r :+ IpeAttributes (DefaultFromIpe (Point 2 r)) r0) Source # |
Converting *to* IpeObjects
IpeWrite
class IpeWrite t where Source #
Types that correspond to an XML Element. All instances should produce an
Element. If the type should produce a Node with the Text constructor, use
the IpeWriteText
typeclass instead.
Instances
IpeWrite LayerName Source # | |
IpeWrite IpePreamble Source # | |
Defined in Ipe.Writer | |
IpeWrite IpeStyle Source # | |
IpeWrite View Source # | |
IpeWrite () Source # | |
IpeWrite t => IpeWrite (NonEmpty t) Source # | |
IpeWriteText r => IpeWrite (Group r) Source # | |
IpeWriteText r => IpeWrite (Image r) Source # | |
IpeWriteText r => IpeWrite (IpeObject r) Source # | |
IpeWriteText r => IpeWrite (IpeSymbol r) Source # | |
IpeWriteText r => IpeWrite (MiniPage r) Source # | |
IpeWriteText r => IpeWrite (TextLabel r) Source # | |
IpeWriteText r => IpeWrite (Path r) Source # | |
IpeWriteText r => IpeWrite (IpeFile r) Source # | |
IpeWriteText r => IpeWrite (IpePage r) Source # | |
IpeWrite t => IpeWrite [t] Source # | |
(IpeWrite l, IpeWrite r) => IpeWrite (Either l r) Source # | |
(IpeWriteText r, EndPoint_ (endPoint point), IxValue (endPoint point) ~ point, Vertex (LineSegment endPoint point) ~ point, Point_ point 2 r) => IpeWrite (LineSegment endPoint point) Source # | |
Defined in Ipe.Writer | |
(AllConstrained IpeAttrName rs, RecordToList rs, RMap rs, ReifyConstraint IpeWriteText (Attr f) rs, RecAll (Attr f) rs IpeWriteText, IpeWrite g) => IpeWrite (g :+ Attributes f rs) Source # | |
Defined in Ipe.Writer | |
(IpeWriteText r, Point_ point 2 r, Functor f, Foldable1 f) => IpeWrite (PolyLineF f point) Source # | |
class IpeWriteText t where Source #
For types that can produce a text value
ipeWriteText :: t -> Maybe Text Source #
Instances
IpeWriteText FillType Source # | |
Defined in Ipe.Writer | |
IpeWriteText HorizontalAlignment Source # | |
Defined in Ipe.Writer | |
IpeWriteText PinType Source # | |
Defined in Ipe.Writer | |
IpeWriteText TransformationTypes Source # | |
Defined in Ipe.Writer | |
IpeWriteText VerticalAlignment Source # | |
Defined in Ipe.Writer | |
IpeWriteText LayerName Source # | |
Defined in Ipe.Writer | |
IpeWriteText Text Source # | |
Defined in Ipe.Writer | |
IpeWriteText Integer Source # | |
Defined in Ipe.Writer | |
IpeWriteText String Source # | |
Defined in Ipe.Writer | |
IpeWriteText () Source # | |
Defined in Ipe.Writer ipeWriteText :: () -> Maybe Text Source # | |
IpeWriteText Double Source # | |
Defined in Ipe.Writer | |
IpeWriteText Float Source # | |
Defined in Ipe.Writer | |
IpeWriteText Int Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (RGB r) Source # | |
Defined in Ipe.Writer | |
Integral a => IpeWriteText (Ratio a) Source # | This instance converts the ratio to a Pico, and then displays that. |
Defined in Ipe.Writer | |
(IpeWriteText r, Point_ point 2 r) => IpeWriteText (CubicBezier point) Source # | |
Defined in Ipe.Writer ipeWriteText :: CubicBezier point -> Maybe Text Source # | |
(IpeWriteText r, Point_ point 2 r) => IpeWriteText (PolyLine point) Source # | |
Defined in Ipe.Writer | |
(IpeWriteText r, Point_ point 2 r) => IpeWriteText (SimplePolygon point) Source # | |
Defined in Ipe.Writer ipeWriteText :: SimplePolygon point -> Maybe Text Source # | |
IpeWriteText r => IpeWriteText (IpeArrow r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (IpeDash r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (IpePen r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (IpeSize r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (IpeColor r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (Operation r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (Path r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (PathSegment r) Source # | |
Defined in Ipe.Writer ipeWriteText :: PathSegment r -> Maybe Text Source # | |
IpeWriteText v => IpeWriteText (IpeValue v) Source # | |
Defined in Ipe.Writer | |
IpeWriteText (RealNumber p) Source # | |
Defined in Ipe.Writer ipeWriteText :: RealNumber p -> Maybe Text Source # | |
HasResolution p => IpeWriteText (Fixed p) Source # | |
Defined in Ipe.Writer | |
(IpeWriteText l, IpeWriteText r) => IpeWriteText (Either l r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (Point 2 r) Source # | |
Defined in Ipe.Writer | |
IpeWriteText (Apply f at) => IpeWriteText (Attr f at) Source # | |
Defined in Ipe.Writer | |
IpeWriteText r => IpeWriteText (Matrix 3 3 r) Source # | |
Defined in Ipe.Writer ipeWriteText :: Matrix 3 3 r -> Maybe Text Source # |
IpeOut
module Ipe.IpeOut
Batch reexports
module Ipe.Attributes
module Ipe.Value
Defines a color in Ipe. Colors are either RGB Values or Named values.
Instances
Functor IpeColor Source # | |
Foldable IpeColor Source # | |
Defined in Ipe.Color fold :: Monoid m => IpeColor m -> m # foldMap :: Monoid m => (a -> m) -> IpeColor a -> m # foldMap' :: Monoid m => (a -> m) -> IpeColor a -> m # foldr :: (a -> b -> b) -> b -> IpeColor a -> b # foldr' :: (a -> b -> b) -> b -> IpeColor a -> b # foldl :: (b -> a -> b) -> b -> IpeColor a -> b # foldl' :: (b -> a -> b) -> b -> IpeColor a -> b # foldr1 :: (a -> a -> a) -> IpeColor a -> a # foldl1 :: (a -> a -> a) -> IpeColor a -> a # elem :: Eq a => a -> IpeColor a -> Bool # maximum :: Ord a => IpeColor a -> a # minimum :: Ord a => IpeColor a -> a # | |
Traversable IpeColor Source # | |
Read r => Read (IpeColor r) Source # | |
Show r => Show (IpeColor r) Source # | |
Eq r => Eq (IpeColor r) Source # | |
Ord r => Ord (IpeColor r) Source # | |
Coordinate r => IpeReadText (IpeColor r) Source # | |
Defined in Ipe.Reader ipeReadText :: Text -> Either ConversionError (IpeColor r) Source # | |
IpeWriteText r => IpeWriteText (IpeColor r) Source # | |
Defined in Ipe.Writer |