{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Ipe.IpeOut
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Functions that help drawing geometric values in ipe. An "IpeOut" is
-- essenitally a function that converts a geometric type g into an IpeObject.
--
-- We also proivde a "HasDefaultIpeOut" typeclass that defines a default
-- conversion function from a geometry type g to an ipe type.
--
--------------------------------------------------------------------------------
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


--------------------------------------------------------------------------------

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :{
-- let myPolygon = fromPoints . map ext $ [origin, Point2 10 10, Point2 100 200]
-- :}

--------------------------------------------------------------------------------
-- * The IpeOut type and the default combinator to use it

type IpeOut g i r = g -> IpeObject' i r

-- | Give the option to draw zero, one or more things, i.e. by
-- choosing f ~ Maybe or f ~ []
type IpeOut' f g i r = g -> f (IpeObject' i r)


-- | Add attributes to an IpeObject'
(!)       :: 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)

-- | Render an ipe object
--
--
-- >>> :{
--   iO $ defIO myPolygon ! attr SFill (IpeColor "blue")
--                        ! attr SLayer "alpha"
--                        ! attr SLayer "beta"
-- :}
-- IpePath (Path {_pathSegments = LSeq (fromList [PolygonPath SimplePolygon CSeq [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [100,200] :+ ()]])} :+ Attrs {Attr LayerName {_layerName = "beta"}, NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "blue"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})
--
-- >>> :{
--   iO $ ipeGroup [ iO $ ipePolygon myPolygon ! attr SFill (IpeColor "red")
--                 ] ! attr SLayer "alpha"
-- :}
-- IpeGroup (Group [IpePath (Path {_pathSegments = LSeq (fromList [PolygonPath SimplePolygon CSeq [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [100,200] :+ ()]])} :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "red"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})] :+ Attrs {Attr LayerName {_layerName = "alpha"}, NoAttr, NoAttr, NoAttr, NoAttr})
--
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

-- | Render to an ipe object using the defIO IpeOut
--
--
-- >>> :{
--   iO'' myPolygon $  attr SFill (IpeColor "red")
--                  <> attr SLayer "alpha"
--                  <> attr SLayer "beta"
-- :}
-- IpePath (Path {_pathSegments = LSeq (fromList [PolygonPath SimplePolygon CSeq [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [100,200] :+ ()]])} :+ Attrs {Attr LayerName {_layerName = "beta"}, NoAttr, NoAttr, NoAttr, NoAttr, Attr IpeColor (Named "red"), NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})
--
-- >>> iO'' [ myPolygon , myPolygon ] $ attr SLayer "alpha"
-- IpeGroup (Group [IpePath (Path {_pathSegments = LSeq (fromList [PolygonPath SimplePolygon CSeq [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [100,200] :+ ()]])} :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr}),IpePath (Path {_pathSegments = LSeq (fromList [PolygonPath SimplePolygon CSeq [Point2 [0,0] :+ (),Point2 [10,10] :+ (),Point2 [100,200] :+ ()]])} :+ Attrs {NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr, NoAttr})] :+ Attrs {Attr LayerName {_layerName = "alpha"}, NoAttr, NoAttr, NoAttr, NoAttr})
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

-- | generate an ipe object without any specific attributes
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

--------------------------------------------------------------------------------
-- * Default Conversions

-- | Class that specifies a default conversion from a geometry type g into an
-- ipe object.
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

--------------------------------------------------------------------------------
-- * Point Converters

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)"

--------------------------------------------------------------------------------
-- * Path Converters

-- | Size of the default bounding box used to clip lines and
-- half-lines in the default IpeOuts.
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)

-- | Renders a line as a Path. The line is clipped to the 'defaultBox'
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

-- | Renders the line in the given box.
--
-- pre: the intersection of the box with the line is non-empty
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

-- | Renders an Halfine.
--
--
-- pre: the intersection of the box with the line is non-empty
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

-- | Renders the HalfLine in the given box.
--
-- pre: the intersection of the box with the line is non-empty
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

-- | Helper to construct a path from a singleton item
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 ())

-- | Draw a polygon
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


-- | Draw a Rectangle
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

--------------------------------------------------------------------------------
-- * Group Converters

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


--------------------------------------------------------------------------------
-- * Text Converters

-- | Creates an text label
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


-- | Annotate an IpeOut with a label
labelled                 :: (Show lbl, NumType g ~ r, ToObject i)
                         => (g -> Point 2 r) -- ^ where to place the label
                         -> IpeOut g i r     -- ^ how to draw the geometric object
                         -> 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)]