Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Image r = Image () (Rectangle () r)
- imageData :: forall r. Lens' (Image r) ()
- rect :: forall r r. Lens (Image r) (Image r) (Rectangle () r) (Rectangle () r)
- data TextLabel r = Label Text (Point 2 r)
- data MiniPage r = MiniPage Text (Point 2 r) r
- width :: MiniPage t -> t
- data IpeSymbol r = Symbol (Point 2 r) Text
- symbolPoint :: forall r r. Lens (IpeSymbol r) (IpeSymbol r) (Point 2 r) (Point 2 r)
- symbolName :: forall r. Lens' (IpeSymbol r) Text
- newtype Path r = Path (LSeq 1 (PathSegment r))
- pathSegments :: forall r r. Iso (Path r) (Path r) (LSeq 1 (PathSegment r)) (LSeq 1 (PathSegment r))
- data PathSegment r
- = PolyLineSegment (PolyLine 2 () r)
- | PolygonPath (SimplePolygon () r)
- | CubicBezierSegment (BezierSpline 3 2 r)
- | QuadraticBezierSegment (BezierSpline 2 2 r)
- | EllipseSegment (Ellipse r)
- | ArcSegment
- | SplineSegment
- | ClosedSplineSegment
- newtype Group r = Group [IpeObject r]
- groupItems :: Lens (Group r) (Group s) [IpeObject r] [IpeObject s]
- 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)
- _IpeGroup :: forall r. Prism' (IpeObject r) (IpeObject' Group r)
- _IpeImage :: forall r. Prism' (IpeObject r) (IpeObject' Image r)
- _IpeTextLabel :: forall r. Prism' (IpeObject r) (IpeObject' TextLabel r)
- _IpeMiniPage :: forall r. Prism' (IpeObject r) (IpeObject' MiniPage r)
- _IpeUse :: forall r. Prism' (IpeObject r) (IpeObject' IpeSymbol r)
- _IpePath :: forall r. Prism' (IpeObject r) (IpeObject' Path r)
- type IpeObject' g r = g r :+ IpeAttributes g r
- ipeObject' :: ToObject i => i r -> IpeAttributes i r -> IpeObject r
- class ToObject i where
- mkIpeObject :: IpeObject' i r -> IpeObject r
- type IpeAttributes g r = Attributes' r (AttributesOf g)
- type Attributes' r = Attributes (AttrMapSym1 r)
- type family AttributesOf (t :: * -> *) :: [u] where ...
- type family AttrMap (r :: *) (l :: AttributeUniverse) :: * where ...
- data AttrMapSym1 (r6989586621679265591 :: Type) :: (~>) AttributeUniverse Type
- attributes :: Lens' (IpeObject' g r) (IpeAttributes g r)
- traverseIpeAttrs :: (Applicative f, AllConstrained TraverseIpeAttr (AttributesOf g)) => proxy g -> (r -> f s) -> IpeAttributes g r -> f (IpeAttributes g s)
- commonAttributes :: Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes)
- flattenGroups :: [IpeObject r] -> [IpeObject r]
Documentation
Image Objects
Instances
Text Objects
Instances
Instances
Ipe Symbols, i.e. Points
A symbol (point) in ipe
Instances
A path is a non-empty sequence of PathSegments.
Path (LSeq 1 (PathSegment r)) |
Instances
pathSegments :: forall r r. Iso (Path r) (Path r) (LSeq 1 (PathSegment r)) (LSeq 1 (PathSegment r)) Source #
data PathSegment r Source #
Paths
Paths consist of Path Segments. PathSegments come in the following forms:
PolyLineSegment (PolyLine 2 () r) | |
PolygonPath (SimplePolygon () r) | |
CubicBezierSegment (BezierSpline 3 2 r) | |
QuadraticBezierSegment (BezierSpline 2 2 r) | |
EllipseSegment (Ellipse r) | |
ArcSegment | |
SplineSegment | |
ClosedSplineSegment |
Instances
Groups and Objects
Group Attributes
A group is essentially a list of IpeObjects.
Instances
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
_IpeTextLabel :: forall r. Prism' (IpeObject r) (IpeObject' TextLabel r) Source #
_IpeMiniPage :: forall r. Prism' (IpeObject r) (IpeObject' MiniPage r) Source #
type IpeObject' g 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 where Source #
mkIpeObject :: IpeObject' i r -> IpeObject r Source #
Instances
ToObject Path Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' Path r -> IpeObject r Source # | |
ToObject Image Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' Image r -> IpeObject r Source # | |
ToObject IpeSymbol Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' IpeSymbol r -> IpeObject r Source # | |
ToObject MiniPage Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' MiniPage r -> IpeObject r Source # | |
ToObject TextLabel Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' TextLabel r -> IpeObject r Source # | |
ToObject Group Source # | |
Defined in Data.Geometry.Ipe.Content mkIpeObject :: IpeObject' Group r -> IpeObject r Source # |
type IpeAttributes g r = Attributes' r (AttributesOf g) Source #
type Attributes' r = Attributes (AttrMapSym1 r) Source #
Attributes' :: * -> [AttributeUniverse] -> *
type family AttributesOf (t :: * -> *) :: [u] 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 Opacity = IpeOpacity | |
AttrMap r Tiling = IpeTiling | |
AttrMap r Gradient = IpeGradient | |
AttrMap r Clip = Path r |
data AttrMapSym1 (r6989586621679265591 :: Type) :: (~>) AttributeUniverse Type Source #
Instances
SuppressUnusedWarnings (AttrMapSym1 r6989586621679265591 :: TyFun AttributeUniverse Type -> Type) Source # | |
Defined in Data.Geometry.Ipe.Content suppressUnusedWarnings :: () # | |
type Apply (AttrMapSym1 r6989586621679265591 :: TyFun AttributeUniverse Type -> Type) (l6989586621679265592 :: AttributeUniverse) Source # | |
Defined in Data.Geometry.Ipe.Content type Apply (AttrMapSym1 r6989586621679265591 :: TyFun AttributeUniverse Type -> Type) (l6989586621679265592 :: AttributeUniverse) = AttrMap r6989586621679265591 l6989586621679265592 |
attributes :: Lens' (IpeObject' g r) (IpeAttributes g r) Source #
traverseIpeAttrs :: (Applicative f, AllConstrained TraverseIpeAttr (AttributesOf g)) => proxy g -> (r -> f s) -> IpeAttributes g r -> f (IpeAttributes g s) Source #
traverse for ipe attributes
commonAttributes :: Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes) Source #
flattenGroups :: [IpeObject r] -> [IpeObject r] Source #
collect all non-group objects