{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ipe.IpeOut where
import Control.Lens hiding (Simple)
import Data.Bifunctor
import Data.Ext
import Data.Foldable (toList)
import Data.Geometry.Ball
import Data.Geometry.BezierSpline
import Data.Geometry.Boundary
import Data.Geometry.Box
import Data.Geometry.Ellipse (Ellipse, circleToEllipse)
import Data.Geometry.HalfLine
import Ipe.Attributes
import Ipe.Color (IpeColor(..))
import Ipe.FromIpe
import Ipe.Types
import Data.Geometry.Line
import Data.Geometry.LineSegment
import Data.Geometry.Point
import Data.Geometry.PolyLine (PolyLine,fromLineSegment)
import Data.Geometry.Polygon
import Data.Geometry.Polygon.Convex
import Data.Geometry.Properties
import qualified Data.LSeq as LSeq
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Vinyl (Rec(..))
import Data.Vinyl.CoRec
type IpeOut g i r = g -> IpeObject' i r
type IpeOut' f g i r = g -> f (IpeObject' i r)
(!) :: IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
(!) IpeObject' i r
i IpeAttributes i r
ats = IpeObject' i r
iIpeObject' i r
-> (IpeObject' i r -> IpeObject' i r) -> IpeObject' i r
forall a b. a -> (a -> b) -> b
&(IpeAttributes i r -> Identity (IpeAttributes i r))
-> IpeObject' i r -> Identity (IpeObject' i r)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((IpeAttributes i r -> Identity (IpeAttributes i r))
-> IpeObject' i r -> Identity (IpeObject' i r))
-> (IpeAttributes i r -> IpeAttributes i r)
-> IpeObject' i r
-> IpeObject' i r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (IpeAttributes i r -> IpeAttributes i r -> IpeAttributes i r
forall a. Semigroup a => a -> a -> a
<> IpeAttributes i r
ats)
iO :: ToObject i => IpeObject' i r -> IpeObject r
iO :: IpeObject' i r -> IpeObject r
iO = IpeObject' i r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
mkIpeObject
iO'' :: ( HasDefaultIpeOut g, NumType g ~ r
, DefaultIpeOut g ~ i, ToObject i
) => g -> IpeAttributes i r
-> IpeObject r
iO'' :: g -> IpeAttributes i r -> IpeObject r
iO'' g
g IpeAttributes i r
ats = IpeObject' i r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' i r -> IpeObject r) -> IpeObject' i r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ IpeOut g (DefaultIpeOut g) (NumType g)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO g
g IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! IpeAttributes i r
ats
iO' :: HasDefaultIpeOut g => g -> IpeObject (NumType g)
iO' :: g -> IpeObject (NumType g)
iO' = IpeObject' (DefaultIpeOut g) (NumType g) -> IpeObject (NumType g)
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' (DefaultIpeOut g) (NumType g) -> IpeObject (NumType g))
-> (g -> IpeObject' (DefaultIpeOut g) (NumType g))
-> g
-> IpeObject (NumType g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> IpeObject' (DefaultIpeOut g) (NumType g)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO
class ToObject (DefaultIpeOut g) => HasDefaultIpeOut g where
type DefaultIpeOut g :: * -> *
defIO :: IpeOut g (DefaultIpeOut g) (NumType g)
instance (HasDefaultIpeOut g, a ~ IpeAttributes (DefaultIpeOut g) (NumType g))
=> HasDefaultIpeOut (g :+ a) where
type DefaultIpeOut (g :+ a) = DefaultIpeOut g
defIO :: IpeOut (g :+ a) (DefaultIpeOut (g :+ a)) (NumType (g :+ a))
defIO (g
g :+ a
ats) = IpeOut g (DefaultIpeOut g) (NumType g)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO g
g (DefaultIpeOut g (NumType g)
:+ IpeAttributes (DefaultIpeOut g) (NumType g))
-> IpeAttributes (DefaultIpeOut g) (NumType g)
-> DefaultIpeOut g (NumType g)
:+ IpeAttributes (DefaultIpeOut g) (NumType g)
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! a
IpeAttributes (DefaultIpeOut g) (NumType g)
ats
instance HasDefaultIpeOut a => HasDefaultIpeOut [a] where
type DefaultIpeOut [a] = Group
defIO :: IpeOut [a] (DefaultIpeOut [a]) (NumType [a])
defIO = [IpeObject (NumType a)]
-> Group (NumType a)
:+ Attributes
(AttrMapSym1 (NumType a))
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup ([IpeObject (NumType a)]
-> Group (NumType a)
:+ Attributes
(AttrMapSym1 (NumType a))
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> ([a] -> [IpeObject (NumType a)])
-> [a]
-> Group (NumType a)
:+ Attributes
(AttrMapSym1 (NumType a))
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IpeObject (NumType a)) -> [a] -> [IpeObject (NumType a)]
forall a b. (a -> b) -> [a] -> [b]
map (IpeObject' (DefaultIpeOut a) (NumType a) -> IpeObject (NumType a)
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' (DefaultIpeOut a) (NumType a) -> IpeObject (NumType a))
-> (a -> IpeObject' (DefaultIpeOut a) (NumType a))
-> a
-> IpeObject (NumType a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IpeObject' (DefaultIpeOut a) (NumType a)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO)
instance HasDefaultIpeOut (Point 2 r) where
type DefaultIpeOut (Point 2 r) = IpeSymbol
defIO :: IpeOut
(Point 2 r) (DefaultIpeOut (Point 2 r)) (NumType (Point 2 r))
defIO = IpeOut
(Point 2 r) (DefaultIpeOut (Point 2 r)) (NumType (Point 2 r))
forall r. IpeOut (Point 2 r) IpeSymbol r
ipeDiskMark
instance HasDefaultIpeOut (LineSegment 2 p r) where
type DefaultIpeOut (LineSegment 2 p r) = Path
defIO :: IpeOut
(LineSegment 2 p r)
(DefaultIpeOut (LineSegment 2 p r))
(NumType (LineSegment 2 p r))
defIO = IpeOut
(LineSegment 2 p r)
(DefaultIpeOut (LineSegment 2 p r))
(NumType (LineSegment 2 p r))
forall p r. IpeOut (LineSegment 2 p r) Path r
ipeLineSegment
instance HasDefaultIpeOut (PolyLine 2 p r) where
type DefaultIpeOut (PolyLine 2 p r) = Path
defIO :: IpeOut
(PolyLine 2 p r)
(DefaultIpeOut (PolyLine 2 p r))
(NumType (PolyLine 2 p r))
defIO = IpeOut
(PolyLine 2 p r)
(DefaultIpeOut (PolyLine 2 p r))
(NumType (PolyLine 2 p r))
forall p r. IpeOut (PolyLine 2 p r) Path r
ipePolyLine
instance (Fractional r, Ord r) => HasDefaultIpeOut (Line 2 r) where
type DefaultIpeOut (Line 2 r) = Path
defIO :: IpeOut (Line 2 r) (DefaultIpeOut (Line 2 r)) (NumType (Line 2 r))
defIO = IpeOut (Line 2 r) (DefaultIpeOut (Line 2 r)) (NumType (Line 2 r))
forall r. (Ord r, Fractional r) => IpeOut (Line 2 r) Path r
ipeLine
instance (Fractional r, Ord r) => HasDefaultIpeOut (HalfLine 2 r) where
type DefaultIpeOut (HalfLine 2 r) = Path
defIO :: IpeOut
(HalfLine 2 r)
(DefaultIpeOut (HalfLine 2 r))
(NumType (HalfLine 2 r))
defIO = IpeOut
(HalfLine 2 r)
(DefaultIpeOut (HalfLine 2 r))
(NumType (HalfLine 2 r))
forall r. (Ord r, Fractional r) => IpeOut (HalfLine 2 r) Path r
ipeHalfLine
instance HasDefaultIpeOut (Polygon t p r) where
type DefaultIpeOut (Polygon t p r) = Path
defIO :: IpeOut
(Polygon t p r)
(DefaultIpeOut (Polygon t p r))
(NumType (Polygon t p r))
defIO = IpeOut
(Polygon t p r)
(DefaultIpeOut (Polygon t p r))
(NumType (Polygon t p r))
forall (t :: PolygonType) p r. IpeOut (Polygon t p r) Path r
ipePolygon
instance HasDefaultIpeOut (SomePolygon p r) where
type DefaultIpeOut (SomePolygon p r) = Path
defIO :: IpeOut
(SomePolygon p r)
(DefaultIpeOut (SomePolygon p r))
(NumType (SomePolygon p r))
defIO = (Polygon 'Simple p r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> (Polygon 'Multi p r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> SomePolygon p r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Polygon 'Simple p r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO Polygon 'Multi p r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO
instance HasDefaultIpeOut (ConvexPolygon p r) where
type DefaultIpeOut (ConvexPolygon p r) = Path
defIO :: IpeOut
(ConvexPolygon p r)
(DefaultIpeOut (ConvexPolygon p r))
(NumType (ConvexPolygon p r))
defIO = SimplePolygon p r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO (SimplePolygon p r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> (ConvexPolygon p r -> SimplePolygon p r)
-> ConvexPolygon p r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (SimplePolygon p r) (ConvexPolygon p r) (SimplePolygon p r)
-> ConvexPolygon p r -> SimplePolygon p r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (SimplePolygon p r) (ConvexPolygon p r) (SimplePolygon p r)
forall p1 r1 p2 r2.
Iso
(ConvexPolygon p1 r1)
(ConvexPolygon p2 r2)
(SimplePolygon p1 r1)
(SimplePolygon p2 r2)
simplePolygon
instance HasDefaultIpeOut (Ellipse r) where
type DefaultIpeOut (Ellipse r) = Path
defIO :: IpeOut
(Ellipse r) (DefaultIpeOut (Ellipse r)) (NumType (Ellipse r))
defIO = IpeOut
(Ellipse r) (DefaultIpeOut (Ellipse r)) (NumType (Ellipse r))
forall r. IpeOut (Ellipse r) Path r
ipeEllipse
instance Floating r => HasDefaultIpeOut (Disk p r) where
type DefaultIpeOut (Disk p r) = Path
defIO :: IpeOut (Disk p r) (DefaultIpeOut (Disk p r)) (NumType (Disk p r))
defIO = IpeOut (Disk p r) (DefaultIpeOut (Disk p r)) (NumType (Disk p r))
forall r p. Floating r => IpeOut (Disk p r) Path r
ipeDisk
instance Floating r => HasDefaultIpeOut (Circle p r) where
type DefaultIpeOut (Circle p r) = Path
defIO :: IpeOut
(Circle p r) (DefaultIpeOut (Circle p r)) (NumType (Circle p r))
defIO = IpeOut
(Circle p r) (DefaultIpeOut (Circle p r)) (NumType (Circle p r))
forall r p. Floating r => IpeOut (Circle p r) Path r
ipeCircle
instance Num r => HasDefaultIpeOut (Rectangle p r) where
type DefaultIpeOut (Rectangle p r) = Path
defIO :: IpeOut
(Rectangle p r)
(DefaultIpeOut (Rectangle p r))
(NumType (Rectangle p r))
defIO = IpeOut
(Rectangle p r)
(DefaultIpeOut (Rectangle p r))
(NumType (Rectangle p r))
forall r p. Num r => IpeOut (Rectangle p r) Path r
ipeRectangle
ipeMark :: Text -> IpeOut (Point 2 r) IpeSymbol r
ipeMark :: Text -> IpeOut (Point 2 r) IpeSymbol r
ipeMark Text
n Point 2 r
p = Point 2 r -> Text -> IpeSymbol r
forall r. Point 2 r -> Text -> IpeSymbol r
Symbol Point 2 r
p Text
n IpeSymbol r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
'Size]
-> IpeSymbol r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
'Size]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Pen,
'Size]
forall a. Monoid a => a
mempty
ipeDiskMark :: IpeOut (Point 2 r) IpeSymbol r
ipeDiskMark :: IpeOut (Point 2 r) IpeSymbol r
ipeDiskMark = Text -> IpeOut (Point 2 r) IpeSymbol r
forall r. Text -> IpeOut (Point 2 r) IpeSymbol r
ipeMark Text
"mark/disk(sx)"
defaultBox :: Num r => Rectangle () r
defaultBox :: Rectangle () r
defaultBox = let z :: r
z = r
1000
z' :: r
z' = r -> r
forall a. Num a => a -> a
negate r
z
in (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> Rectangle () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> Box d p r
box (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext (Point 2 r -> Point 2 r :+ ()) -> Point 2 r -> Point 2 r :+ ()
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
z' r
z') (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext (Point 2 r -> Point 2 r :+ ()) -> Point 2 r -> Point 2 r :+ ()
forall a b. (a -> b) -> a -> b
$ r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
z r
z)
ipeLine :: (Ord r, Fractional r) => IpeOut (Line 2 r) Path r
ipeLine :: IpeOut (Line 2 r) Path r
ipeLine = Rectangle () r -> IpeOut (Line 2 r) Path r
forall p r.
(Ord r, Fractional r) =>
Rectangle p r -> IpeOut (Line 2 r) Path r
ipeLineIn Rectangle () r
forall r. Num r => Rectangle () r
defaultBox
ipeLineIn :: forall p r. (Ord r, Fractional r)
=> Rectangle p r -> IpeOut (Line 2 r) Path r
ipeLineIn :: Rectangle p r -> IpeOut (Line 2 r) Path r
ipeLineIn Rectangle p r
bBox Line 2 r
l = CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r
-> Rectangle p r -> Intersection (Line 2 r) (Rectangle p r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle p r
bBox) (Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> [Char]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => [Char] -> a
error [Char]
"ipeLineIn: precondition failed, no intersection")
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
NoIntersection
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
_p :: Point 2 r) -> [Char]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => [Char] -> a
error [Char]
"ipeLineIn: precondition failed, single point")
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(Point 2 r)
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[LineSegment 2 () r]
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[Point 2 r, LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 () r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(LineSegment 2 () r)
forall b a. (a -> b) -> Handler b a
H LineSegment 2 () r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall p r. IpeOut (LineSegment 2 p r) Path r
ipeLineSegment
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(LineSegment 2 () r)
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[]
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
ipeHalfLine :: (Ord r, Fractional r) => IpeOut (HalfLine 2 r) Path r
ipeHalfLine :: IpeOut (HalfLine 2 r) Path r
ipeHalfLine = Rectangle () r -> IpeOut (HalfLine 2 r) Path r
forall p r.
(Ord r, Fractional r) =>
Rectangle p r -> IpeOut (HalfLine 2 r) Path r
ipeHalfLineIn Rectangle () r
forall r. Num r => Rectangle () r
defaultBox
ipeHalfLineIn :: forall p r. (Ord r, Fractional r)
=> Rectangle p r -> IpeOut (HalfLine 2 r) Path r
ipeHalfLineIn :: Rectangle p r -> IpeOut (HalfLine 2 r) Path r
ipeHalfLineIn Rectangle p r
bBox HalfLine 2 r
l = CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (HalfLine 2 r
l HalfLine 2 r
-> Rectangle p r -> Intersection (HalfLine 2 r) (Rectangle p r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle p r
bBox) (Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> [Char]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => [Char] -> a
error [Char]
"ipeHalfLineIn: precondition failed, no intersection")
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
NoIntersection
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[Point 2 r, LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, LineSegment 2 () r]
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
_p :: Point 2 r) -> [Char]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => [Char] -> a
error [Char]
"ipeHalfLineIn: precondition failed, single point")
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(Point 2 r)
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[LineSegment 2 () r]
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[Point 2 r, LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 () r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(LineSegment 2 () r)
forall b a. (a -> b) -> Handler b a
H LineSegment 2 () r
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall p r. IpeOut (LineSegment 2 p r) Path r
ipeLineSegment
Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
(LineSegment 2 () r)
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[]
-> Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
ipeLineSegment :: IpeOut (LineSegment 2 p r) Path r
ipeLineSegment :: IpeOut (LineSegment 2 p r) Path r
ipeLineSegment LineSegment 2 p r
s = (PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (PathSegment r -> Path r)
-> (LineSegment 2 p r -> PathSegment r)
-> LineSegment 2 p r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineSegment 2 p r -> PathSegment r
forall p r. LineSegment 2 p r -> PathSegment r
pathSegment (LineSegment 2 p r -> Path r) -> LineSegment 2 p r -> Path r
forall a b. (a -> b) -> a -> b
$ LineSegment 2 p r
s) Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
ipePolyLine :: IpeOut (PolyLine 2 p r) Path r
ipePolyLine :: IpeOut (PolyLine 2 p r) Path r
ipePolyLine PolyLine 2 p r
p = (PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (PathSegment r -> Path r)
-> (PolyLine 2 p r -> PathSegment r) -> PolyLine 2 p r -> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine 2 () r -> PathSegment r
forall r. PolyLine 2 () r -> PathSegment r
PolyLineSegment (PolyLine 2 () r -> PathSegment r)
-> (PolyLine 2 p r -> PolyLine 2 () r)
-> PolyLine 2 p r
-> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> ()) -> PolyLine 2 p r -> PolyLine 2 () r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ()) (PolyLine 2 p r -> Path r) -> PolyLine 2 p r -> Path r
forall a b. (a -> b) -> a -> b
$ PolyLine 2 p r
p) Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
ipeEllipse :: IpeOut (Ellipse r) Path r
ipeEllipse :: IpeOut (Ellipse r) Path r
ipeEllipse = \Ellipse r
e -> PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (Ellipse r -> PathSegment r
forall r. Ellipse r -> PathSegment r
EllipseSegment Ellipse r
e) Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
ipeCircle :: Floating r => IpeOut (Circle p r) Path r
ipeCircle :: IpeOut (Circle p r) Path r
ipeCircle = Ellipse r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall r. IpeOut (Ellipse r) Path r
ipeEllipse (Ellipse r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> (Circle p r -> Ellipse r)
-> Circle p r
-> Path r
:+ Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Circle p r -> Ellipse r
forall r p. Floating r => Circle p r -> Ellipse r
circleToEllipse
ipeDisk :: Floating r => IpeOut (Disk p r) Path r
ipeDisk :: IpeOut (Disk p r) Path r
ipeDisk Disk p r
d = IpeOut (Circle p r) Path r
forall r p. Floating r => IpeOut (Circle p r) Path r
ipeCircle (Disk p r -> Circle p r
forall g. g -> Boundary g
Boundary Disk p r
d) IpeObject' Path r -> IpeAttributes Path r -> IpeObject' Path r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! SAttributeUniverse 'Fill
-> Apply (AttrMapSym1 r) 'Fill
-> Attributes
(AttrMapSym1 r)
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall u (at :: u) (ats :: [u]) (proxy :: u -> *) (f :: u ~> *).
(at ∈ ats, RecApplicative ats) =>
proxy at -> Apply f at -> Attributes f ats
attr SAttributeUniverse 'Fill
SFill (IpeValue (RGB r) -> IpeColor r
forall r. IpeValue (RGB r) -> IpeColor r
IpeColor IpeValue (RGB r)
"0.722 0.145 0.137")
ipeBezier :: IpeOut (BezierSpline 3 2 r) Path r
ipeBezier :: IpeOut (BezierSpline 3 2 r) Path r
ipeBezier BezierSpline 3 2 r
b = (PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (PathSegment r -> Path r) -> PathSegment r -> Path r
forall a b. (a -> b) -> a -> b
$ BezierSpline 3 2 r -> PathSegment r
forall r. BezierSpline 3 2 r -> PathSegment r
CubicBezierSegment BezierSpline 3 2 r
b) Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
path :: PathSegment r -> Path r
path :: PathSegment r -> Path r
path = LSeq 1 (PathSegment r) -> Path r
forall r. LSeq 1 (PathSegment r) -> Path r
Path (LSeq 1 (PathSegment r) -> Path r)
-> (PathSegment r -> LSeq 1 (PathSegment r))
-> PathSegment r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r)
forall a. NonEmpty a -> LSeq 1 a
LSeq.fromNonEmpty (NonEmpty (PathSegment r) -> LSeq 1 (PathSegment r))
-> (PathSegment r -> NonEmpty (PathSegment r))
-> PathSegment r
-> LSeq 1 (PathSegment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment r -> [PathSegment r] -> NonEmpty (PathSegment r)
forall a. a -> [a] -> NonEmpty a
:| [])
pathSegment :: LineSegment 2 p r -> PathSegment r
pathSegment :: LineSegment 2 p r -> PathSegment r
pathSegment = PolyLine 2 () r -> PathSegment r
forall r. PolyLine 2 () r -> PathSegment r
PolyLineSegment (PolyLine 2 () r -> PathSegment r)
-> (LineSegment 2 p r -> PolyLine 2 () r)
-> LineSegment 2 p r
-> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineSegment 2 () r -> PolyLine 2 () r
forall (d :: Nat) p r. LineSegment d p r -> PolyLine d p r
fromLineSegment (LineSegment 2 () r -> PolyLine 2 () r)
-> (LineSegment 2 p r -> LineSegment 2 () r)
-> LineSegment 2 p r
-> PolyLine 2 () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p -> ()) -> LineSegment 2 p r -> LineSegment 2 () r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ())
ipePolygon :: IpeOut (Polygon t p r) Path r
ipePolygon :: IpeOut (Polygon t p r) Path r
ipePolygon ((p -> ()) -> Polygon t p r -> Polygon t () r
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> p -> ()
forall a b. a -> b -> a
const ()) -> Polygon t () r
pg) = case Polygon t () r
pg of
SimplePolygon{} -> Polygon t () r
pgPolygon t () r
-> Getting (Path r) (Polygon t () r) (Path r) -> Path r
forall s a. s -> Getting a s a -> a
^.AReview (Path r) (Polygon 'Simple () r)
-> Getter (Polygon 'Simple () r) (Path r)
forall t b. AReview t b -> Getter b t
re AReview (Path r) (Polygon 'Simple () r)
forall r. Prism' (Path r) (Polygon 'Simple () r)
_asSimplePolygon Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
MultiPolygon{} -> Polygon t () r
pgPolygon t () r
-> Getting (Path r) (Polygon t () r) (Path r) -> Path r
forall s a. s -> Getting a s a -> a
^.AReview (Path r) (MultiPolygon () r)
-> Getter (MultiPolygon () r) (Path r)
forall t b. AReview t b -> Getter b t
re AReview (Path r) (MultiPolygon () r)
forall r. Prism' (Path r) (MultiPolygon () r)
_asMultiPolygon Path r
-> Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> Path r
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
r
'[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. Monoid a => a
mempty
ipeRectangle :: Num r => IpeOut (Rectangle p r) Path r
ipeRectangle :: IpeOut (Rectangle p r) Path r
ipeRectangle Rectangle p r
r = IpeOut (Polygon 'Simple p r) Path r
forall (t :: PolygonType) p r. IpeOut (Polygon t p r) Path r
ipePolygon IpeOut (Polygon 'Simple p r) Path r
-> IpeOut (Polygon 'Simple p r) Path r
forall a b. (a -> b) -> a -> b
$ [Point 2 r :+ p] -> Polygon 'Simple p r
forall r p. [Point 2 r :+ p] -> SimplePolygon p r
unsafeFromPoints [Point 2 r :+ p
tl,Point 2 r :+ p
tr,Point 2 r :+ p
br,Point 2 r :+ p
bl]
where
Corners Point 2 r :+ p
tl Point 2 r :+ p
tr Point 2 r :+ p
br Point 2 r :+ p
bl = Rectangle p r -> Corners (Point 2 r :+ p)
forall r p. Num r => Rectangle p r -> Corners (Point 2 r :+ p)
corners Rectangle p r
r
ipeGroup :: Foldable f => IpeOut (f (IpeObject r)) Group r
ipeGroup :: IpeOut (f (IpeObject r)) Group r
ipeGroup f (IpeObject r)
xs = [IpeObject r] -> Group r
forall r. [IpeObject r] -> Group r
Group (f (IpeObject r) -> [IpeObject r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (IpeObject r)
xs) Group r
-> Attributes' r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
-> Group r
:+ Attributes' r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall core extra. core -> extra -> core :+ extra
:+ Attributes' r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall a. Monoid a => a
mempty
ipeLabel :: IpeOut (Text :+ Point 2 r) TextLabel r
ipeLabel :: IpeOut (Text :+ Point 2 r) TextLabel r
ipeLabel (Text
txt :+ Point 2 r
p) = Text -> Point 2 r -> TextLabel r
forall r. Text -> Point 2 r -> TextLabel r
Label Text
txt Point 2 r
p TextLabel r
-> Attributes' r CommonAttributes
-> TextLabel r :+ Attributes' r CommonAttributes
forall core extra. core -> extra -> core :+ extra
:+ Attributes' r CommonAttributes
forall a. Monoid a => a
mempty
labelled :: (Show lbl, NumType g ~ r, ToObject i)
=> (g -> Point 2 r)
-> IpeOut g i r
-> IpeOut (g :+ lbl) Group r
labelled :: (g -> Point 2 r) -> IpeOut g i r -> IpeOut (g :+ lbl) Group r
labelled g -> Point 2 r
pos IpeOut g i r
f (g
g :+ lbl
lbl) = IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup [IpeObject' i r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' i r -> IpeObject r) -> IpeObject' i r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ IpeOut g i r
f g
g, IpeObject' TextLabel r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' TextLabel r -> IpeObject r)
-> IpeObject' TextLabel r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ IpeOut (Text :+ Point 2 r) TextLabel r
forall r. IpeOut (Text :+ Point 2 r) TextLabel r
ipeLabel (([Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ lbl -> [Char]
forall a. Show a => a -> [Char]
show lbl
lbl) Text -> Point 2 r -> Text :+ Point 2 r
forall core extra. core -> extra -> core :+ extra
:+ g -> Point 2 r
pos g
g)]