| Safe Haskell | None | 
|---|---|
| Language | Haskell2010 | 
Data.Geometry.Ipe.Types
Contents
- newtype LayerName = LayerName {
- _layerName :: Text
 
 - data Image r = Image {
- _imageData :: ()
 - _rect :: Rectangle () r
 
 - rect :: forall r r. Lens (Image r) (Image r) (Rectangle () r) (Rectangle () r)
 - imageData :: forall r. Lens' (Image 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 {
- _symbolPoint :: Point 2 r
 - _symbolName :: Text
 
 - symbolPoint :: forall r r. Lens (IpeSymbol r) (IpeSymbol r) (Point 2 r) (Point 2 r)
 - symbolName :: forall r. Lens' (IpeSymbol r) Text
 - data PathSegment r
- = PolyLineSegment (PolyLine 2 () r)
 - | PolygonPath (SimplePolygon () r)
 - | CubicBezierSegment
 - | QuadraticBezierSegment
 - | EllipseSegment (Matrix 3 3 r)
 - | ArcSegment
 - | SplineSegment
 - | ClosedSplineSegment
 
 - _ClosedSplineSegment :: forall r. Prism' (PathSegment r) ()
 - _SplineSegment :: forall r. Prism' (PathSegment r) ()
 - _ArcSegment :: forall r. Prism' (PathSegment r) ()
 - _EllipseSegment :: forall r. Prism' (PathSegment r) (Matrix 3 3 r)
 - _QuadraticBezierSegment :: forall r. Prism' (PathSegment r) ()
 - _CubicBezierSegment :: forall r. Prism' (PathSegment r) ()
 - _PolygonPath :: forall r. Prism' (PathSegment r) (SimplePolygon () r)
 - _PolyLineSegment :: forall r. Prism' (PathSegment r) (PolyLine 2 () r)
 - newtype Path r = Path {
- _pathSegments :: ViewL1 (PathSegment r)
 
 - pathSegments :: forall r r. Iso (Path r) (Path r) (ViewL1 (PathSegment r)) (ViewL1 (PathSegment r))
 - data Operation r
 - _ClosePath :: forall r. Prism' (Operation r) ()
 - _ClosedSpline :: forall r. Prism' (Operation r) [Point 2 r]
 - _Spline :: forall r. Prism' (Operation r) [Point 2 r]
 - _ArcTo :: forall r. Prism' (Operation r) (Matrix 3 3 r, Point 2 r)
 - _Ellipse :: forall r. Prism' (Operation r) (Matrix 3 3 r)
 - _QCurveTo :: forall r. Prism' (Operation r) (Point 2 r, Point 2 r)
 - _CurveTo :: forall r. Prism' (Operation r) (Point 2 r, Point 2 r, Point 2 r)
 - _LineTo :: forall r. Prism' (Operation r) (Point 2 r)
 - _MoveTo :: forall r. Prism' (Operation r) (Point 2 r)
 - type family AttrMap (r :: *) (l :: AttributeUniverse) :: * where ...
 - type AttrMapSym2 t t = AttrMap t t
 - data AttrMapSym1 l l = (KindOf (Apply (AttrMapSym1 l) arg) ~ KindOf (AttrMapSym2 l arg)) => AttrMapSym1KindInference
 - data AttrMapSym0 l = (KindOf (Apply AttrMapSym0 arg) ~ KindOf (AttrMapSym1 arg)) => AttrMapSym0KindInference
 - newtype Group r = Group {
- _groupItems :: [IpeObject r]
 
 - type family AttributesOf (t :: * -> *) :: [u] where ...
 - type Attributes' r = Attributes (AttrMapSym1 r)
 - type IpeAttributes g r = Attributes' r (AttributesOf g)
 - type IpeObject' g r = g r :+ IpeAttributes g r
 - attributes :: Lens' (IpeObject' g r) (IpeAttributes g 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. Prism' (IpeObject r) (IpeObject' Path r)
 - _IpeUse :: forall r. Prism' (IpeObject r) (IpeObject' IpeSymbol r)
 - _IpeMiniPage :: forall r. Prism' (IpeObject r) (IpeObject' MiniPage r)
 - _IpeTextLabel :: forall r. Prism' (IpeObject r) (IpeObject' TextLabel r)
 - _IpeImage :: forall r. Prism' (IpeObject r) (IpeObject' Image r)
 - _IpeGroup :: forall r. Prism' (IpeObject r) (IpeObject' Group r)
 - groupItems :: forall r r. Iso (Group r) (Group r) [IpeObject r] [IpeObject r]
 - class ToObject i where
 - commonAttributes :: Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes)
 - data View = View {}
 - layerNames :: Lens' View [LayerName]
 - activeLayer :: Lens' View LayerName
 - data IpeStyle = IpeStyle {
- _styleName :: Maybe Text
 - _styleData :: Node Text Text
 
 - styleName :: Lens' IpeStyle (Maybe Text)
 - styleData :: Lens' IpeStyle (Node Text Text)
 - basicIpeStyle :: IpeStyle
 - data IpePreamble = IpePreamble {
- _encoding :: Maybe Text
 - _preambleData :: Text
 
 - preambleData :: Lens' IpePreamble Text
 - encoding :: Lens' IpePreamble (Maybe Text)
 - type IpeBitmap = Text
 - data IpePage r = IpePage {}
 - views :: forall r. Lens' (IpePage r) [View]
 - layers :: forall r. Lens' (IpePage r) [LayerName]
 - content :: forall r r. Lens (IpePage r) (IpePage r) [IpeObject r] [IpeObject r]
 - fromContent :: [IpeObject r] -> IpePage r
 - data IpeFile r = IpeFile {}
 - styles :: forall r. Lens' (IpeFile r) [IpeStyle]
 - preamble :: forall r. Lens' (IpeFile r) (Maybe IpePreamble)
 - pages :: forall r r. Lens (IpeFile r) (IpeFile r) (NonEmpty (IpePage r)) (NonEmpty (IpePage r))
 - singlePageFile :: IpePage r -> IpeFile r
 - singlePageFromContent :: [IpeObject r] -> IpeFile r
 - applyMatrix' :: (IsTransformable (i r), Matrix ∈ AttributesOf i, Dimension (i r) ~ 2, r ~ NumType (i r)) => IpeObject' i r -> IpeObject' i r
 - applyMatrix :: Num r => IpeObject r -> IpeObject r
 - applyMatrices :: Num r => IpeFile r -> IpeFile r
 - applyMatricesPage :: Num r => IpePage r -> IpePage r
 
Documentation
Constructors
| LayerName | |
Fields 
  | |
Image Objects
Constructors
| Image | |
Fields 
  | |
Instances
| ToObject Image Source # | |
| Eq r => Eq (Image r) Source # | |
| Ord r => Ord (Image r) Source # | |
| Show r => Show (Image r) Source # | |
| Num r => IsTransformable (Image r) Source # | |
| Coordinate r => IpeRead (Image r) Source # | |
| IpeWriteText r => IpeWrite (Image r) Source # | |
| type NumType (Image r) Source # | |
| type Dimension (Image r) Source # | |
Text Objects
Instances
| ToObject TextLabel Source # | |
| Eq r => Eq (TextLabel r) Source # | |
| Ord r => Ord (TextLabel r) Source # | |
| Show r => Show (TextLabel r) Source # | |
| Num r => IsTransformable (TextLabel r) Source # | |
| Coordinate r => IpeRead (TextLabel r) Source # | |
| IpeWriteText r => IpeWrite (TextLabel r) Source # | |
| type NumType (TextLabel r) Source # | |
| type Dimension (TextLabel r) Source # | |
Instances
| ToObject MiniPage Source # | |
| Eq r => Eq (MiniPage r) Source # | |
| Ord r => Ord (MiniPage r) Source # | |
| Show r => Show (MiniPage r) Source # | |
| Num r => IsTransformable (MiniPage r) Source # | |
| Coordinate r => IpeRead (MiniPage r) Source # | |
| IpeWriteText r => IpeWrite (MiniPage r) Source # | |
| type NumType (MiniPage r) Source # | |
| type Dimension (MiniPage r) Source # | |
Ipe Symbols, i.e. Points
A symbol (point) in ipe
Constructors
| Symbol | |
Fields 
  | |
Instances
| ToObject IpeSymbol Source # | |
| Eq r => Eq (IpeSymbol r) Source # | |
| Ord r => Ord (IpeSymbol r) Source # | |
| Show r => Show (IpeSymbol r) Source # | |
| Num r => IsTransformable (IpeSymbol r) Source # | |
| Coordinate r => IpeRead (IpeSymbol r) Source # | Ipe read instances  | 
| IpeWriteText r => IpeWrite (IpeSymbol r) Source # | |
| type NumType (IpeSymbol r) Source # | |
| type Dimension (IpeSymbol r) Source # | |
data PathSegment r Source #
Example of an IpeSymbol. I.e. A symbol that expresses that the size is large
 sizeSymbol :: Attributes (AttrMapSym1 r) (SymbolAttributes r)
 sizeSymbol = attr SSize (IpeSize $ Named "large")
Paths
Paths consist of Path Segments. PathSegments come in the following forms:
Constructors
| PolyLineSegment (PolyLine 2 () r) | |
| PolygonPath (SimplePolygon () r) | |
| CubicBezierSegment | |
| QuadraticBezierSegment | |
| EllipseSegment (Matrix 3 3 r) | |
| ArcSegment | |
| SplineSegment | |
| ClosedSplineSegment | 
Instances
| Eq r => Eq (PathSegment r) Source # | |
| Show r => Show (PathSegment r) Source # | |
| Num r => IsTransformable (PathSegment r) Source # | |
| Coordinate r => IpeRead (PathSegment r) Source # | |
| Coordinate r => IpeReadText (NonEmpty (PathSegment r)) Source # | |
| IpeWriteText r => IpeWriteText (PathSegment r) Source # | |
| type NumType (PathSegment r) Source # | |
| type Dimension (PathSegment r) Source # | |
_ClosedSplineSegment :: forall r. Prism' (PathSegment r) () Source #
_SplineSegment :: forall r. Prism' (PathSegment r) () Source #
_ArcSegment :: forall r. Prism' (PathSegment r) () Source #
_EllipseSegment :: forall r. Prism' (PathSegment r) (Matrix 3 3 r) Source #
_QuadraticBezierSegment :: forall r. Prism' (PathSegment r) () Source #
_CubicBezierSegment :: forall r. Prism' (PathSegment r) () Source #
_PolygonPath :: forall r. Prism' (PathSegment r) (SimplePolygon () r) Source #
_PolyLineSegment :: forall r. Prism' (PathSegment r) (PolyLine 2 () r) Source #
A path is a non-empty sequence of PathSegments.
Constructors
| Path | |
Fields 
  | |
Instances
| ToObject Path Source # | |
| Eq r => Eq (Path r) Source # | |
| Show r => Show (Path r) Source # | |
| Num r => IsTransformable (Path r) Source # | |
| Coordinate r => IpeRead (Path r) Source # | |
| Coordinate r => IpeReadText (Path r) Source # | |
| IpeWriteText r => IpeWrite (Path r) Source # | |
| IpeWriteText r => IpeWriteText (Path r) Source # | |
| type NumType (Path r) Source # | |
| type Dimension (Path r) Source # | |
pathSegments :: forall r r. Iso (Path r) (Path r) (ViewL1 (PathSegment r)) (ViewL1 (PathSegment r)) Source #
type that represents a path in ipe.
Constructors
| MoveTo (Point 2 r) | |
| LineTo (Point 2 r) | |
| CurveTo (Point 2 r) (Point 2 r) (Point 2 r) | |
| QCurveTo (Point 2 r) (Point 2 r) | |
| Ellipse (Matrix 3 3 r) | |
| ArcTo (Matrix 3 3 r) (Point 2 r) | |
| Spline [Point 2 r] | |
| ClosedSpline [Point 2 r] | |
| ClosePath | 
Instances
| Eq r => Eq (Operation r) Source # | |
| Show r => Show (Operation r) Source # | |
| Coordinate r => IpeReadText [Operation r] Source # | |
| IpeWriteText r => IpeWriteText (Operation r) Source # | |
_ClosePath :: forall r. Prism' (Operation r) () Source #
Attribute Mapping
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'.
Equations
| AttrMap r Layer = LayerName | |
| AttrMap r Matrix = Matrix 3 3 r | |
| AttrMap r Pin = PinType | |
| AttrMap r Transformations = TransformationTypes | |
| AttrMap r Stroke = IpeColor | |
| AttrMap r Pen = IpePen r | |
| AttrMap r Fill = IpeColor | |
| 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 | 
type AttrMapSym2 t t = AttrMap t t Source #
data AttrMapSym1 l l Source #
Constructors
| (KindOf (Apply (AttrMapSym1 l) arg) ~ KindOf (AttrMapSym2 l arg)) => AttrMapSym1KindInference | 
Instances
| SuppressUnusedWarnings (Type -> TyFun AttributeUniverse Type -> *) AttrMapSym1 Source # | |
| type Apply AttributeUniverse Type (AttrMapSym1 l1) l0 Source # | |
data AttrMapSym0 l Source #
Constructors
| (KindOf (Apply AttrMapSym0 arg) ~ KindOf (AttrMapSym1 arg)) => AttrMapSym0KindInference | 
Instances
| SuppressUnusedWarnings (TyFun Type (TyFun AttributeUniverse Type -> Type) -> *) AttrMapSym0 Source # | |
| type Apply Type (TyFun AttributeUniverse Type -> Type) AttrMapSym0 l0 Source # | |
Groups and Objects
Group Attributes
A group is essentially a list of IpeObjects.
Constructors
| Group | |
Fields 
  | |
type family AttributesOf (t :: * -> *) :: [u] where ... Source #
type Attributes' r = Attributes (AttrMapSym1 r) Source #
Attributes' :: * -> [AttributeUniverse] -> *
type IpeAttributes g r = Attributes' r (AttributesOf g) Source #
type IpeObject' g r = g r :+ IpeAttributes g r Source #
An IpeObject' is essentially the oject ogether with its attributes
attributes :: Lens' (IpeObject' g r) (IpeAttributes g r) Source #
Constructors
| 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
_IpeMiniPage :: forall r. Prism' (IpeObject r) (IpeObject' MiniPage r) Source #
_IpeTextLabel :: forall r. Prism' (IpeObject r) (IpeObject' TextLabel r) Source #
class ToObject i where Source #
Minimal complete definition
Methods
ipeObject' :: i r -> IpeAttributes i r -> IpeObject r Source #
commonAttributes :: Lens' (IpeObject r) (Attributes (AttrMapSym1 r) CommonAttributes) Source #
The definition of a view make active layer into an index ?
Constructors
| View | |
Fields 
  | |
for now we pretty much ignore these
Constructors
| IpeStyle | |
Fields 
  | |
data IpePreamble Source #
The maybe string is the encoding
Constructors
| IpePreamble | |
Fields 
  | |
Instances
An IpePage is essentially a Group, together with a list of layers and a list of views.
fromContent :: [IpeObject r] -> IpePage r Source #
Creates a simple page with no views.
A complete ipe file
Constructors
| IpeFile | |
pages :: forall r r. Lens (IpeFile r) (IpeFile r) (NonEmpty (IpePage r)) (NonEmpty (IpePage r)) Source #
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
applyMatrix' :: (IsTransformable (i r), Matrix ∈ AttributesOf i, Dimension (i r) ~ 2, r ~ NumType (i r)) => IpeObject' i r -> IpeObject' i r Source #
Takes and applies the ipe Matrix attribute of this item.