Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | Haskell2010 |
Data type modeling the various elements in Ipe files.
Synopsis
- newtype LayerName = LayerName Text
- layerName :: Iso' LayerName Text
- 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]
- 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
- data IpePreamble = IpePreamble (Maybe Text) Text
- encoding :: Lens' IpePreamble (Maybe Text)
- preambleData :: Lens' IpePreamble Text
- type IpeBitmap = Text
- data IpePage r = IpePage [LayerName] [View] [IpeObject r]
- layers :: forall r. Lens' (IpePage r) [LayerName]
- views :: forall r. Lens' (IpePage r) [View]
- content :: forall r r. Lens (IpePage r) (IpePage r) [IpeObject r] [IpeObject 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 IpeFile r = IpeFile (Maybe IpePreamble) [IpeStyle] (NonEmpty (IpePage r))
- preamble :: forall r. Lens' (IpeFile r) (Maybe IpePreamble)
- styles :: forall r. Lens' (IpeFile r) [IpeStyle]
- pages :: forall r r. Lens (IpeFile r) (IpeFile r) (NonEmpty (IpePage r)) (NonEmpty (IpePage r))
- ipeFile :: NonEmpty (IpePage r) -> IpeFile r
- singlePageFile :: IpePage r -> IpeFile r
- singlePageFromContent :: [IpeObject r] -> IpeFile r
Documentation
Instances
Eq LayerName Source # | |
Ord LayerName Source # | |
Defined in Data.Geometry.Ipe.Layer | |
Read LayerName Source # | |
Show LayerName Source # | |
IsString LayerName Source # | |
Defined in Data.Geometry.Ipe.Layer fromString :: String -> LayerName # | |
IpeRead LayerName Source # | |
Defined in Data.Geometry.Ipe.Reader | |
IpeReadText LayerName Source # | |
Defined in Data.Geometry.Ipe.Reader | |
IpeWrite LayerName Source # | |
IpeWriteText LayerName Source # | |
Defined in Data.Geometry.Ipe.Writer |
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
The definition of a view make active layer into an index ?
for now we pretty much ignore these
data IpePreamble Source #
The maybe string is the encoding
Instances
Eq IpePreamble Source # | |
Defined in Data.Geometry.Ipe.Types (==) :: IpePreamble -> IpePreamble -> Bool # (/=) :: IpePreamble -> IpePreamble -> Bool # | |
Ord IpePreamble Source # | |
Defined in Data.Geometry.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 # | |
Read IpePreamble Source # | |
Defined in Data.Geometry.Ipe.Types readsPrec :: Int -> ReadS IpePreamble # readList :: ReadS [IpePreamble] # readPrec :: ReadPrec IpePreamble # readListPrec :: ReadPrec [IpePreamble] # | |
Show IpePreamble Source # | |
Defined in Data.Geometry.Ipe.Types showsPrec :: Int -> IpePreamble -> ShowS # show :: IpePreamble -> String # showList :: [IpePreamble] -> ShowS # | |
IpeWrite IpePreamble Source # | |
Defined in Data.Geometry.Ipe.Writer |
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 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.
A complete ipe file
pages :: forall r r. Lens (IpeFile r) (IpeFile r) (NonEmpty (IpePage r)) (NonEmpty (IpePage r)) Source #
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