{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- 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, holes)
import           Data.Foldable (toList)
import           Data.Foldable1 (Foldable1)
import           Data.Kind
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Sequence as Seq
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Vector.NonEmpty (NonEmptyVector)
import           HGeometry.Ball
import           HGeometry.BezierSpline
import           HGeometry.Box
import           HGeometry.Disk
import           HGeometry.Ellipse (Ellipse, circleToEllipse)
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import           HGeometry.HalfLine
import           HGeometry.HalfSpace
import           HGeometry.Intersection
import           HGeometry.Line
import           HGeometry.LineSegment
import           HGeometry.Number.Radical
import           HGeometry.Point
import           HGeometry.Point.Either
import           HGeometry.PolyLine
import           HGeometry.Polygon
import           HGeometry.Polygon.Convex.Unbounded
import           HGeometry.Polygon.Simple.PossiblyDegenerate
import           HGeometry.Polygon.WithHoles
import           HGeometry.Properties
import           HGeometry.Triangle (Triangle,toCounterClockwiseTriangle)
import           Ipe.Attributes
import           Ipe.Color (IpeColor(..), gray)
import           Ipe.FromIpe
import           Ipe.FromIpe.UnboundedConvexChain
import           Ipe.Path (Orientation(..))
import           Ipe.Types

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

-- $setup
-- >>> :seti -XOverloadedStrings
-- >>> :{
-- let Just (myPolygon :: SimplePolygon (Point 2 Int)) = fromPoints $ [origin, Point2 10 10, Point2 100 200]
-- :}

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

-- | an IpeOut is just a function that can construct an appropriate IpeObject'
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
! :: forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
(!) IpeObject' i r
i Attributes' r (AttributesOf i)
ats = IpeObject' i r
iIpeObject' i r
-> (IpeObject' i r -> IpeObject' i r) -> IpeObject' i r
forall a b. a -> (a -> b) -> b
&(Attributes' r (AttributesOf i)
 -> Identity (Attributes' r (AttributesOf i)))
-> IpeObject' i r -> Identity (IpeObject' i r)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra ((Attributes' r (AttributesOf i)
  -> Identity (Attributes' r (AttributesOf i)))
 -> IpeObject' i r -> Identity (IpeObject' i r))
-> (Attributes' r (AttributesOf i)
    -> Attributes' r (AttributesOf i))
-> IpeObject' i r
-> IpeObject' i r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Attributes' r (AttributesOf i)
-> Attributes' r (AttributesOf i) -> Attributes' r (AttributesOf i)
forall a. Semigroup a => a -> a -> a
<> Attributes' r (AttributesOf i)
ats)

-- | Render an ipe object
--
--
-- >>> :{
--   iO $ defIO myPolygon ! attr SFill (IpeColor "blue")
--                        ! attr SLayer "alpha"
--                        ! attr SLayer "beta"
-- :}
-- IpePath (Path {_pathSegments = fromList [PolygonPath AsIs (SimplePolygon [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, NoAttr})
--
-- >>> :{
--   iO $ ipeGroup [ iO $ ipePolygon myPolygon ! attr SFill (IpeColor "red")
--                 ] ! attr SLayer "alpha"
-- :}
-- IpeGroup (Group [IpePath (Path {_pathSegments = fromList [PolygonPath AsIs (SimplePolygon [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, NoAttr})] :+ Attrs {Attr LayerName {_layerName = "alpha"}, NoAttr, NoAttr, NoAttr, NoAttr})
--
iO :: ToObject i => IpeObject' i r -> IpeObject r
iO :: forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO = IpeObject' i r -> IpeObject r
forall r. 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 = fromList [PolygonPath AsIs (SimplePolygon [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, NoAttr})
--
-- >>> iO'' [ myPolygon , myPolygon ] $ attr SLayer "alpha"
-- IpeGroup (Group [IpePath (Path {_pathSegments = fromList [PolygonPath AsIs (SimplePolygon [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, NoAttr}),IpePath (Path {_pathSegments = fromList [PolygonPath AsIs (SimplePolygon [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, 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'' :: forall g r (i :: * -> *).
(HasDefaultIpeOut g, NumType g ~ r, DefaultIpeOut g ~ i,
 ToObject i) =>
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' :: forall g. HasDefaultIpeOut g => 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
  -- | The type of ipe object (e.g. Path, Group, IpeSymbol) we render to
  type DefaultIpeOut g :: Type -> Type
  -- | The default way of rendering a value of type g into an ipe object. In particular,
  -- an ipe object of 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]
IpeOut [IpeObject (NumType a)] Group (NumType a)
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 a => HasDefaultIpeOut (NonEmpty a) where
  type DefaultIpeOut (NonEmpty a) = Group
  defIO :: IpeOut
  (NonEmpty a) (DefaultIpeOut (NonEmpty a)) (NumType (NonEmpty a))
defIO = [IpeObject (NumType a)]
-> Group (NumType a)
   :+ Attributes
        (AttrMapSym1 (NumType a))
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
IpeOut [IpeObject (NumType a)] Group (NumType a)
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])
-> (NonEmpty a -> [IpeObject (NumType a)])
-> NonEmpty 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) ([a] -> [IpeObject (NumType a)])
-> (NonEmpty a -> [a]) -> NonEmpty a -> [IpeObject (NumType a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance (HasDefaultIpeOut a, HasDefaultIpeOut b
         , DefaultIpeOut a ~ DefaultIpeOut b, NumType a ~ NumType b
         ) => HasDefaultIpeOut (Either a b) where
  type DefaultIpeOut (Either a b) = DefaultIpeOut a
  defIO :: IpeOut
  (Either a b) (DefaultIpeOut (Either a b)) (NumType (Either a b))
defIO = (a
 -> DefaultIpeOut b (NumType b)
    :+ Attributes' (NumType b) (AttributesOf (DefaultIpeOut b)))
-> (b
    -> DefaultIpeOut b (NumType b)
       :+ Attributes' (NumType b) (AttributesOf (DefaultIpeOut b)))
-> Either a b
-> DefaultIpeOut b (NumType b)
   :+ Attributes' (NumType b) (AttributesOf (DefaultIpeOut b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IpeOut a (DefaultIpeOut a) (NumType a)
a
-> DefaultIpeOut b (NumType b)
   :+ Attributes' (NumType b) (AttributesOf (DefaultIpeOut b))
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO b
-> DefaultIpeOut b (NumType b)
   :+ Attributes' (NumType b) (AttributesOf (DefaultIpeOut b))
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) IpeSymbol r
IpeOut
  (Point 2 r) (DefaultIpeOut (Point 2 r)) (NumType (Point 2 r))
forall r. IpeOut (Point 2 r) IpeSymbol r
ipeDiskMark

instance ( HasDefaultIpeOut original, HasDefaultIpeOut extra
         , DefaultIpeOut original ~ DefaultIpeOut extra
         , NumType original ~ NumType extra
         ) => HasDefaultIpeOut (OriginalOrExtra original extra) where
  type DefaultIpeOut (OriginalOrExtra original extra) = DefaultIpeOut original
  defIO :: IpeOut
  (OriginalOrExtra original extra)
  (DefaultIpeOut (OriginalOrExtra original extra))
  (NumType (OriginalOrExtra original extra))
defIO = \case
    Original original
o -> IpeOut original (DefaultIpeOut original) (NumType original)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO original
o
    Extra extra
e    -> IpeOut extra (DefaultIpeOut extra) (NumType extra)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO extra
e

instance ( IxValue (endPoint (Point 2 r)) ~ Point 2 r
         , EndPoint_ (endPoint (Point 2 r))
         ) => HasDefaultIpeOut (LineSegment endPoint (Point 2 r)) where
  type DefaultIpeOut (LineSegment endPoint (Point 2 r)) = Path
  defIO :: IpeOut
  (LineSegment endPoint (Point 2 r))
  (DefaultIpeOut (LineSegment endPoint (Point 2 r)))
  (NumType (LineSegment endPoint (Point 2 r)))
defIO = IpeOut (LineSegment endPoint (Point 2 r)) Path r
IpeOut
  (LineSegment endPoint (Point 2 r))
  (DefaultIpeOut (LineSegment endPoint (Point 2 r)))
  (NumType (LineSegment endPoint (Point 2 r)))
forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
IpeOut lineSegment Path r
ipeLineSegment

instance HasDefaultIpeOut (PolyLine (Point 2 r)) where
  type DefaultIpeOut (PolyLine (Point 2 r)) = Path
  defIO :: IpeOut
  (PolyLine (Point 2 r))
  (DefaultIpeOut (PolyLine (Point 2 r)))
  (NumType (PolyLine (Point 2 r)))
defIO = IpeOut (PolyLine (Point 2 r)) Path r
IpeOut
  (PolyLine (Point 2 r))
  (DefaultIpeOut (PolyLine (Point 2 r)))
  (NumType (PolyLine (Point 2 r)))
forall r. IpeOut (PolyLine (Point 2 r)) Path r
ipePolyLine

instance (Eq r, Num r) => HasDefaultIpeOut (Triangle (Point 2 r)) where
  type DefaultIpeOut (Triangle (Point 2 r)) = Path
  defIO :: IpeOut
  (Triangle (Point 2 r))
  (DefaultIpeOut (Triangle (Point 2 r)))
  (NumType (Triangle (Point 2 r)))
defIO = IpeOut (Triangle (Point 2 r)) Path r
IpeOut
  (Triangle (Point 2 r))
  (DefaultIpeOut (Triangle (Point 2 r)))
  (NumType (Triangle (Point 2 r)))
forall r. (Eq r, Num r) => IpeOut (Triangle (Point 2 r)) Path r
ipeTriangle

instance (Fractional r, Ord r, Show r) => HasDefaultIpeOut (LinePV 2 r) where
  type DefaultIpeOut (LinePV 2 r) = Path
  defIO :: IpeOut
  (LinePV 2 r) (DefaultIpeOut (LinePV 2 r)) (NumType (LinePV 2 r))
defIO = IpeOut (LinePV 2 r) Path r
IpeOut
  (LinePV 2 r) (DefaultIpeOut (LinePV 2 r)) (NumType (LinePV 2 r))
forall r.
(Ord r, Fractional r, Show r) =>
IpeOut (LinePV 2 r) Path r
ipeLine

instance (Fractional r, Ord r, Show r) => HasDefaultIpeOut (LineEQ r) where
  type DefaultIpeOut (LineEQ r) = Path
  defIO :: IpeOut (LineEQ r) (DefaultIpeOut (LineEQ r)) (NumType (LineEQ r))
defIO (LineEQ r
a r
b) = IpeOut (LinePV 2 (NumType (LineEQ r))) Path (NumType (LineEQ r))
forall r.
(Ord r, Fractional r, Show r) =>
IpeOut (LinePV 2 r) Path r
ipeLine IpeOut (LinePV 2 (NumType (LineEQ r))) Path (NumType (LineEQ r))
-> IpeOut (LinePV 2 (NumType (LineEQ r))) Path (NumType (LineEQ r))
forall a b. (a -> b) -> a -> b
$ NumType (LineEQ r)
-> NumType (LineEQ r) -> LinePV 2 (NumType (LineEQ r))
forall r. Num r => r -> r -> LinePV 2 r
fromLinearFunction r
NumType (LineEQ r)
a r
NumType (LineEQ r)
b

instance (Fractional r, Ord r, Show r) => HasDefaultIpeOut (VerticalOrLineEQ r) where
  type DefaultIpeOut (VerticalOrLineEQ r) = Path
  defIO :: IpeOut
  (VerticalOrLineEQ r)
  (DefaultIpeOut (VerticalOrLineEQ r))
  (NumType (VerticalOrLineEQ r))
defIO = \case
    VerticalLineThrough r
x -> IpeOut
  (LinePV 2 (NumType (VerticalOrLineEQ r)))
  Path
  (NumType (VerticalOrLineEQ r))
forall r.
(Ord r, Fractional r, Show r) =>
IpeOut (LinePV 2 r) Path r
ipeLine IpeOut
  (LinePV 2 (NumType (VerticalOrLineEQ r)))
  Path
  (NumType (VerticalOrLineEQ r))
-> IpeOut
     (LinePV 2 (NumType (VerticalOrLineEQ r)))
     Path
     (NumType (VerticalOrLineEQ r))
forall a b. (a -> b) -> a -> b
$ r -> LinePV 2 (NumType (VerticalOrLineEQ r))
forall r line. (Line_ line 2 r, Num r) => r -> line
verticalLine r
x
    NonVertical LineEQ r
l         -> IpeOut (LineEQ r) (DefaultIpeOut (LineEQ r)) (NumType (LineEQ r))
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO LineEQ r
l

instance (Fractional r, Ord r, Point_ point 2 r,Show r, Show point) => HasDefaultIpeOut (HalfLine point) where
  type DefaultIpeOut (HalfLine point) = Path
  defIO :: IpeOut
  (HalfLine point)
  (DefaultIpeOut (HalfLine point))
  (NumType (HalfLine point))
defIO = IpeOut (HalfLine point) Path r
IpeOut
  (HalfLine point)
  (DefaultIpeOut (HalfLine point))
  (NumType (HalfLine point))
forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
IpeOut (HalfLine point) Path r
ipeHalfLine

instance ( VertexContainer f (Point 2 r)
         , HasFromFoldable1 f
         ) => HasDefaultIpeOut (SimplePolygonF f (Point 2 r)) where
  type DefaultIpeOut (SimplePolygonF f (Point 2 r)) = Path
  defIO :: IpeOut
  (SimplePolygonF f (Point 2 r))
  (DefaultIpeOut (SimplePolygonF f (Point 2 r)))
  (NumType (SimplePolygonF f (Point 2 r)))
defIO = IpeOut (SimplePolygonF f (Point 2 r)) Path r
IpeOut
  (SimplePolygonF f (Point 2 r))
  (DefaultIpeOut (SimplePolygonF f (Point 2 r)))
  (NumType (SimplePolygonF f (Point 2 r)))
forall polygon point r.
Polygon_ polygon point r =>
IpeOut polygon Path r
ipePolygon

instance ( HoleContainer h f (Point 2 r)
         , HasFromFoldable1 f
         )
       => HasDefaultIpeOut (PolygonalDomainF h f (Point 2 r)) where
  type DefaultIpeOut (PolygonalDomainF h f (Point 2 r)) = Path
  defIO :: IpeOut
  (PolygonalDomainF h f (Point 2 r))
  (DefaultIpeOut (PolygonalDomainF h f (Point 2 r)))
  (NumType (PolygonalDomainF h f (Point 2 r)))
defIO = IpeOut (PolygonalDomainF h f (Point 2 r)) Path r
IpeOut
  (PolygonalDomainF h f (Point 2 r))
  (DefaultIpeOut (PolygonalDomainF h f (Point 2 r)))
  (NumType (PolygonalDomainF h f (Point 2 r)))
forall polygon point r.
Polygon_ polygon point r =>
IpeOut polygon Path r
ipePolygon

instance ( VertexContainer f (Point 2 r)
         , HasFromFoldable1 f
         ) => HasDefaultIpeOut (ConvexPolygonF f (Point 2 r)) where
  type DefaultIpeOut (ConvexPolygonF f (Point 2 r)) = Path
  defIO :: IpeOut
  (ConvexPolygonF f (Point 2 r))
  (DefaultIpeOut (ConvexPolygonF f (Point 2 r)))
  (NumType (ConvexPolygonF f (Point 2 r)))
defIO = SimplePolygonF f (Point 2 r)
-> Path r
   :+ Attributes
        (AttrMapSym1 r)
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
IpeOut
  (SimplePolygonF f (Point 2 r))
  (DefaultIpeOut (SimplePolygonF f (Point 2 r)))
  (NumType (SimplePolygonF f (Point 2 r)))
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO (SimplePolygonF f (Point 2 r)
 -> Path r
    :+ Attributes
         (AttrMapSym1 r)
         '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
            'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
            'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> (ConvexPolygonF f (Point 2 r) -> SimplePolygonF f (Point 2 r))
-> ConvexPolygonF f (Point 2 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
. ConvexPolygonF f (Point 2 r) -> SimplePolygonF f (Point 2 r)
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon

instance (Num r, Point_ vertex 2 r, Foldable1 nonEmpty
         ) => HasDefaultIpeOut (UnboundedConvexRegionF r nonEmpty vertex) where
  type DefaultIpeOut (UnboundedConvexRegionF r nonEmpty vertex) = Path
  defIO :: IpeOut
  (UnboundedConvexRegionF r nonEmpty vertex)
  (DefaultIpeOut (UnboundedConvexRegionF r nonEmpty vertex))
  (NumType (UnboundedConvexRegionF r nonEmpty vertex))
defIO = (UnboundedConvexRegionF r nonEmpty vertex
 :+ 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]
(UnboundedConvexRegionF r nonEmpty vertex :+ IpeAttributes Path r)
-> IpeObject' Path r
forall (nonEmpty :: * -> *) vertex r.
(Foldable1 nonEmpty, Point_ vertex 2 r, Num r) =>
(UnboundedConvexRegionF r nonEmpty vertex :+ IpeAttributes Path r)
-> IpeObject' Path r
renderChain ((UnboundedConvexRegionF r nonEmpty vertex
  :+ 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])
-> (UnboundedConvexRegionF r nonEmpty vertex
    -> UnboundedConvexRegionF r nonEmpty vertex
       :+ Attributes'
            r
            '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
               'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
               'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> UnboundedConvexRegionF r nonEmpty vertex
-> Path r
   :+ Attributes'
        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
. (UnboundedConvexRegionF r nonEmpty vertex
-> Attributes'
     r
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
        'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
        'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
-> UnboundedConvexRegionF r nonEmpty vertex
   :+ 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)

instance ( HasDefaultIpeOut vertex, HasDefaultIpeOut polygon
         , NumType vertex ~ NumType polygon, Point_ vertex 2 r
         ) => HasDefaultIpeOut (PossiblyDegenerateSimplePolygon vertex polygon) where
  type DefaultIpeOut (PossiblyDegenerateSimplePolygon vertex polygon) = Group
  -- use the default renderer for the various options, and then wrap them in a group
  -- (since they will return things of different types)
  defIO :: IpeOut
  (PossiblyDegenerateSimplePolygon vertex polygon)
  (DefaultIpeOut (PossiblyDegenerateSimplePolygon vertex polygon))
  (NumType (PossiblyDegenerateSimplePolygon vertex polygon))
defIO = (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) (Group r
 -> Group r
    :+ Attributes'
         r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip])
-> (PossiblyDegenerateSimplePolygon vertex polygon -> Group r)
-> PossiblyDegenerateSimplePolygon vertex polygon
-> Group r
   :+ Attributes' r '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Clip]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IpeObject r] -> Group r
forall r. [IpeObject r] -> Group r
Group ([IpeObject r] -> Group r)
-> (PossiblyDegenerateSimplePolygon vertex polygon
    -> [IpeObject r])
-> PossiblyDegenerateSimplePolygon vertex polygon
-> Group r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IpeObject r -> [IpeObject r] -> [IpeObject r]
forall a. a -> [a] -> [a]
:[]) (IpeObject r -> [IpeObject r])
-> (PossiblyDegenerateSimplePolygon vertex polygon -> IpeObject r)
-> PossiblyDegenerateSimplePolygon vertex polygon
-> [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    DegenerateVertex vertex
v -> vertex -> IpeObject (NumType vertex)
forall g. HasDefaultIpeOut g => g -> IpeObject (NumType g)
iO' vertex
v
    DegenerateEdge ClosedLineSegment vertex
e   -> LineSegment (EndPoint 'Closed) (Point 2 r)
-> IpeObject (NumType (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall g. HasDefaultIpeOut g => g -> IpeObject (NumType g)
iO' (LineSegment (EndPoint 'Closed) (Point 2 r)
 -> IpeObject
      (NumType (LineSegment (EndPoint 'Closed) (Point 2 r))))
-> LineSegment (EndPoint 'Closed) (Point 2 r)
-> IpeObject (NumType (LineSegment (EndPoint 'Closed) (Point 2 r)))
forall a b. (a -> b) -> a -> b
$ (vertex -> Getting (Point 2 r) vertex (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) vertex (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' vertex (Point 2 r)
asPoint) (vertex -> Point 2 r)
-> ClosedLineSegment vertex
-> LineSegment (EndPoint 'Closed) (Point 2 r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClosedLineSegment vertex
e
    ActualPolygon polygon
pg   -> polygon -> IpeObject (NumType polygon)
forall g. HasDefaultIpeOut g => g -> IpeObject (NumType g)
iO' polygon
pg

instance HasDefaultIpeOut (Ellipse r) where
  type DefaultIpeOut (Ellipse r) = Path
  defIO :: IpeOut
  (Ellipse r) (DefaultIpeOut (Ellipse r)) (NumType (Ellipse r))
defIO = IpeOut (Ellipse r) Path r
IpeOut
  (Ellipse r) (DefaultIpeOut (Ellipse r)) (NumType (Ellipse r))
forall r. IpeOut (Ellipse r) Path r
ipeEllipse

instance Radical r => HasDefaultIpeOut (Disk (Point 2 r)) where
  type DefaultIpeOut (Disk (Point 2 r)) = Path
  defIO :: IpeOut
  (Disk (Point 2 r))
  (DefaultIpeOut (Disk (Point 2 r)))
  (NumType (Disk (Point 2 r)))
defIO = IpeOut (Disk (Point 2 r)) Path r
IpeOut
  (Disk (Point 2 r))
  (DefaultIpeOut (Disk (Point 2 r)))
  (NumType (Disk (Point 2 r)))
forall r. Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk

instance (Radical r, Fractional r, Point_ point 2 r
         ) => HasDefaultIpeOut (DiametralBall point) where
  type DefaultIpeOut (DiametralBall point) = Path
  defIO :: IpeOut
  (DiametralBall point)
  (DefaultIpeOut (DiametralBall point))
  (NumType (DiametralBall point))
defIO DiametralBall point
disk = IpeOut
  (Disk (Point 2 (NumType (DiametralBall point))))
  Path
  (NumType (DiametralBall point))
forall r. Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk IpeOut
  (Disk (Point 2 (NumType (DiametralBall point))))
  Path
  (NumType (DiametralBall point))
-> IpeOut
     (Disk (Point 2 (NumType (DiametralBall point))))
     Path
     (NumType (DiametralBall point))
forall a b. (a -> b) -> a -> b
$ Point 2 (NumType (DiametralBall point))
-> NumType (Point 2 (NumType (DiametralBall point)))
-> Disk (Point 2 (NumType (DiametralBall point)))
forall point. point -> NumType point -> Disk point
Disk (DiametralBall point
diskDiametralBall point
-> Getting (Point 2 r) (DiametralBall point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (DiametralBall point) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (DiametralBall point) (Point 2 r)
center) (DiametralBall point
diskDiametralBall point -> Getting r (DiametralBall point) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (DiametralBall point) r
(NumType (DiametralBall point)
 -> Const r (NumType (DiametralBall point)))
-> DiametralBall point -> Const r (DiametralBall point)
forall ball point. Ball_ ball point => Getter ball (NumType ball)
Getter (DiametralBall point) (NumType (DiametralBall point))
squaredRadius)

instance (Radical r, Fractional r, Point_ point 2 r
         ) => HasDefaultIpeOut (BallByPoints' 3 point) where
  type DefaultIpeOut (BallByPoints' 3 point) = Path
  defIO :: IpeOut
  (BallByPoints' 3 point)
  (DefaultIpeOut (BallByPoints' 3 point))
  (NumType (BallByPoints' 3 point))
defIO BallByPoints' 3 point
disk = IpeOut
  (Disk (Point 2 (NumType (BallByPoints' 3 point))))
  Path
  (NumType (BallByPoints' 3 point))
forall r. Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk IpeOut
  (Disk (Point 2 (NumType (BallByPoints' 3 point))))
  Path
  (NumType (BallByPoints' 3 point))
-> IpeOut
     (Disk (Point 2 (NumType (BallByPoints' 3 point))))
     Path
     (NumType (BallByPoints' 3 point))
forall a b. (a -> b) -> a -> b
$ Point 2 (NumType (BallByPoints' 3 point))
-> NumType (Point 2 (NumType (BallByPoints' 3 point)))
-> Disk (Point 2 (NumType (BallByPoints' 3 point)))
forall point. point -> NumType point -> Disk point
Disk (BallByPoints' 3 point
diskBallByPoints' 3 point
-> Getting (Point 2 r) (BallByPoints' 3 point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (BallByPoints' 3 point) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (BallByPoints' 3 point) (Point 2 r)
center) (BallByPoints' 3 point
diskBallByPoints' 3 point -> Getting r (BallByPoints' 3 point) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (BallByPoints' 3 point) r
(NumType (BallByPoints' 3 point)
 -> Const r (NumType (BallByPoints' 3 point)))
-> BallByPoints' 3 point -> Const r (BallByPoints' 3 point)
forall ball point. Ball_ ball point => Getter ball (NumType ball)
Getter (BallByPoints' 3 point) (NumType (BallByPoints' 3 point))
squaredRadius)

instance (Radical r, Fractional r, Point_ point 2 r
         ) => HasDefaultIpeOut (DiskByPoints point) where
  type DefaultIpeOut (DiskByPoints point) = Path
  defIO :: IpeOut
  (DiskByPoints point)
  (DefaultIpeOut (DiskByPoints point))
  (NumType (DiskByPoints point))
defIO DiskByPoints point
disk = IpeOut
  (Disk (Point 2 (NumType (DiskByPoints point))))
  Path
  (NumType (DiskByPoints point))
forall r. Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk IpeOut
  (Disk (Point 2 (NumType (DiskByPoints point))))
  Path
  (NumType (DiskByPoints point))
-> IpeOut
     (Disk (Point 2 (NumType (DiskByPoints point))))
     Path
     (NumType (DiskByPoints point))
forall a b. (a -> b) -> a -> b
$ Point 2 (NumType (DiskByPoints point))
-> NumType (Point 2 (NumType (DiskByPoints point)))
-> Disk (Point 2 (NumType (DiskByPoints point)))
forall point. point -> NumType point -> Disk point
Disk (DiskByPoints point
diskDiskByPoints point
-> Getting (Point 2 r) (DiskByPoints point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (DiskByPoints point) (Point 2 r)
forall geom point. HasCenter geom point => Lens' geom point
Lens' (DiskByPoints point) (Point 2 r)
center) (DiskByPoints point
diskDiskByPoints point -> Getting r (DiskByPoints point) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (DiskByPoints point) r
(NumType (DiskByPoints point)
 -> Const r (NumType (DiskByPoints point)))
-> DiskByPoints point -> Const r (DiskByPoints point)
forall ball point. Ball_ ball point => Getter ball (NumType ball)
Getter (DiskByPoints point) (NumType (DiskByPoints point))
squaredRadius)

instance Radical r => HasDefaultIpeOut (Circle (Point 2 r)) where
  type DefaultIpeOut (Circle (Point 2 r)) = Path
  defIO :: IpeOut
  (Circle (Point 2 r))
  (DefaultIpeOut (Circle (Point 2 r)))
  (NumType (Circle (Point 2 r)))
defIO = IpeOut (Circle (Point 2 r)) Path r
IpeOut
  (Circle (Point 2 r))
  (DefaultIpeOut (Circle (Point 2 r)))
  (NumType (Circle (Point 2 r)))
forall r. Radical r => IpeOut (Circle (Point 2 r)) Path r
ipeCircle

instance Num r => HasDefaultIpeOut (Rectangle (Point 2 r)) where
  type DefaultIpeOut (Rectangle (Point 2 r)) = Path
  defIO :: IpeOut
  (Rectangle (Point 2 r))
  (DefaultIpeOut (Rectangle (Point 2 r)))
  (NumType (Rectangle (Point 2 r)))
defIO = IpeOut (Rectangle (Point 2 r)) Path r
IpeOut
  (Rectangle (Point 2 r))
  (DefaultIpeOut (Rectangle (Point 2 r)))
  (NumType (Rectangle (Point 2 r)))
forall r. Num r => IpeOut (Rectangle (Point 2 r)) Path r
ipeRectangle


instance HasDefaultIpeOut (Group r) where
  type DefaultIpeOut (Group r) = Group
  defIO :: IpeOut (Group r) (DefaultIpeOut (Group r)) (NumType (Group r))
defIO = (Group r
-> IpeAttributes (DefaultIpeOut (Group r)) (NumType (Group r))
-> Group r
   :+ IpeAttributes (DefaultIpeOut (Group r)) (NumType (Group r))
forall core extra. core -> extra -> core :+ extra
:+ IpeAttributes (DefaultIpeOut (Group r)) (NumType (Group r))
forall a. Monoid a => a
mempty)

instance (Fractional r, Ord r, Show r) => HasDefaultIpeOut (HalfSpaceF (LinePV 2 r)) where
  type DefaultIpeOut (HalfSpaceF (LinePV 2 r)) = Group
  defIO :: IpeOut
  (HalfSpaceF (LinePV 2 r))
  (DefaultIpeOut (HalfSpaceF (LinePV 2 r)))
  (NumType (HalfSpaceF (LinePV 2 r)))
defIO = IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
forall r.
(Show r, Fractional r, Ord r) =>
IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlane IpeColor r
forall r. IpeColor r
gray

instance (Fractional r, Ord r, Show r) => HasDefaultIpeOut (HalfSpaceF (LineEQ r)) where
  type DefaultIpeOut (HalfSpaceF (LineEQ r)) = Group
  defIO :: IpeOut
  (HalfSpaceF (LineEQ r))
  (DefaultIpeOut (HalfSpaceF (LineEQ r)))
  (NumType (HalfSpaceF (LineEQ r)))
defIO HalfSpaceF (LineEQ r)
h = IpeOut
  (HalfSpaceF (LinePV 2 r))
  (DefaultIpeOut (HalfSpaceF (LinePV 2 r)))
  (NumType (HalfSpaceF (LinePV 2 r)))
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO IpeOut
  (HalfSpaceF (LinePV 2 r))
  (DefaultIpeOut (HalfSpaceF (LinePV 2 r)))
  (NumType (HalfSpaceF (LinePV 2 r)))
-> IpeOut
     (HalfSpaceF (LinePV 2 r))
     (DefaultIpeOut (HalfSpaceF (LinePV 2 r)))
     (NumType (HalfSpaceF (LinePV 2 r)))
forall a b. (a -> b) -> a -> b
$ HalfSpaceF (LineEQ r)
hHalfSpaceF (LineEQ r)
-> (HalfSpaceF (LineEQ r) -> HalfSpaceF (LinePV 2 r))
-> HalfSpaceF (LinePV 2 r)
forall a b. a -> (a -> b) -> b
&(LineEQ r -> Identity (LinePV 2 r))
-> HalfSpaceF (LineEQ r) -> Identity (HalfSpaceF (LinePV 2 r))
forall boundingHyperPlane boundingHyperPlane' (f :: * -> *).
Functor f =>
(boundingHyperPlane -> f boundingHyperPlane')
-> HalfSpaceF boundingHyperPlane
-> f (HalfSpaceF boundingHyperPlane')
boundingHyperPlaneLens ((LineEQ r -> Identity (LinePV 2 r))
 -> HalfSpaceF (LineEQ r) -> Identity (HalfSpaceF (LinePV 2 r)))
-> (LineEQ r -> LinePV 2 r)
-> HalfSpaceF (LineEQ r)
-> HalfSpaceF (LinePV 2 r)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ LineEQ r -> LinePV 2 r
forall r. Num r => LineEQ r -> LinePV 2 r
fromLineEQ

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

ipeMark     :: Text -> IpeOut (Point 2 r) IpeSymbol r
ipeMark :: forall r. 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 :: forall r. 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 (Point 2 r)
defaultBox :: forall r. Num r => Rectangle (Point 2 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 -> Box (Point 2 r)
forall point. (Dimension point ~ 2) => point -> point -> Box point
Rectangle (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
z' r
z') (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, Show r) => IpeOut (LinePV 2 r) Path r
ipeLine :: forall r.
(Ord r, Fractional r, Show r) =>
IpeOut (LinePV 2 r) Path r
ipeLine = Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
forall r.
(Ord r, Fractional r, Show r) =>
Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
ipeLineIn Rectangle (Point 2 r)
forall r. Num r => Rectangle (Point 2 r)
defaultBox




-- | Renders the line in the given box.
--
-- pre: the intersection of the box with the line is non-empty
ipeLineIn        :: forall r. (Ord r, Fractional r, Show r)
                 => Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
ipeLineIn :: forall r.
(Ord r, Fractional r, Show r) =>
Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
ipeLineIn Rectangle (Point 2 r)
bBox LinePV 2 r
l = case LinePV 2 r
l LinePV 2 r
-> Rectangle (Point 2 r)
-> Intersection (LinePV 2 r) (Rectangle (Point 2 r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle (Point 2 r)
bBox of
  Maybe (LineBoxIntersection 2 r)
Intersection (LinePV 2 r) (Rectangle (Point 2 r))
Nothing                         -> String
-> Path r
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => String -> a
error String
"ipeLineIn: precondition failed, no intersection"
  Just (Line_x_Box_Point Point 2 r
_)       -> String
-> Path r
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => String -> a
error String
"ipeLineIn: precondition failed, single point"
  Just (Line_x_Box_LineSegment ClosedLineSegment (Point 2 r)
s) -> IpeOut (ClosedLineSegment (Point 2 r)) Path r
forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
IpeOut lineSegment Path r
ipeLineSegment ClosedLineSegment (Point 2 r)
s

-- | Renders an Halfine.
--
-- pre: the intersection of the box with the line is non-empty
ipeHalfLine :: (Ord r, Fractional r, Point_ point 2 r, Show r, Show point) => IpeOut (HalfLine point) Path r
ipeHalfLine :: forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
IpeOut (HalfLine point) Path r
ipeHalfLine = \(HalfLine point
p Vector (Dimension point) (NumType point)
v) -> Rectangle (Point 2 r) -> IpeOut (HalfLine (Point 2 r)) Path r
forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
Rectangle point -> IpeOut (HalfLine point) Path r
ipeHalfLineIn Rectangle (Point 2 r)
forall r. Num r => Rectangle (Point 2 r)
defaultBox IpeOut (HalfLine (Point 2 r)) Path r
-> IpeOut (HalfLine (Point 2 r)) Path r
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
-> HalfLine (Point 2 r)
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine (point
ppoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Vector (Dimension point) (NumType point)
Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
v

-- | Renders a ray, i.e. a half line drawing an arrow in the direction
-- of the ray.
--
-- pre: the intersection of the box with the line is non-empty
ipeRay :: (Ord r, Fractional r, Point_ point 2 r, Show r, Show point) => IpeOut (HalfLine point) Path r
ipeRay :: forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
IpeOut (HalfLine point) Path r
ipeRay = \HalfLine point
hl -> HalfLine point -> IpeObject' Path r
forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
IpeOut (HalfLine point) Path r
ipeHalfLine HalfLine point
hl IpeObject' Path r -> IpeAttributes Path r -> IpeObject' Path r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! SAttributeUniverse 'Arrow
-> Apply (AttrMapSym1 r) 'Arrow
-> 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 'Arrow
SArrow Apply (AttrMapSym1 r) 'Arrow
IpeArrow r
forall r. IpeArrow r
normalArrow

-- | Renders the HalfLine in the given box.
--
-- pre: the intersection of the box with the halfline is a line segment
ipeHalfLineIn         :: (Ord r, Fractional r, Point_ point 2 r, Show r, Show point)
                      => Rectangle point -> IpeOut (HalfLine point) Path r
ipeHalfLineIn :: forall r point.
(Ord r, Fractional r, Point_ point 2 r, Show r, Show point) =>
Rectangle point -> IpeOut (HalfLine point) Path r
ipeHalfLineIn Rectangle point
bBox HalfLine point
hl = case HalfLine point
hl HalfLine point
-> Rectangle point
-> Intersection (HalfLine point) (Rectangle point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle point
bBox of
  Maybe (HalfLineBoxIntersection (Point 2 r))
Intersection (HalfLine point) (Rectangle point)
Nothing                       -> String -> IpeObject' Path r
forall a. HasCallStack => String -> a
error (String -> IpeObject' Path r) -> String -> IpeObject' Path r
forall a b. (a -> b) -> a -> b
$ String
"ipeHalfLineIn: precondition failed, no intersection"
                                   String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (HalfLine point, Rectangle point) -> String
forall a. Show a => a -> String
show (HalfLine point
hl,Rectangle point
bBox)

  Just (HalfLine_x_Box_Point Point 2 r
_) -> String
-> Path r
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
           'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
           'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient]
forall a. HasCallStack => String -> a
error String
"ipeHalfLineIn: precondition failed, single point"
  Just (HalfLine_x_Box_LineSegment ClosedLineSegment (Point 2 r)
seg) -> IpeOut (ClosedLineSegment (Point 2 r)) Path r
forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
IpeOut lineSegment Path r
ipeLineSegment ClosedLineSegment (Point 2 r)
seg

-- | Renders an line segment to a Path
ipeLineSegment   :: (LineSegment_ lineSegment point, Point_ point 2 r)
                 => IpeOut lineSegment Path r
ipeLineSegment :: forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
IpeOut lineSegment Path r
ipeLineSegment lineSegment
s = (PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (PathSegment r -> Path r)
-> (lineSegment -> PathSegment r) -> lineSegment -> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lineSegment -> PathSegment r
forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
lineSegment -> PathSegment r
pathSegment (lineSegment -> Path r) -> lineSegment -> Path r
forall a b. (a -> b) -> a -> b
$ lineSegment
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

-- | Renders a polyline to a Path
ipePolyLine   :: IpeOut (PolyLine (Point 2 r)) Path r
ipePolyLine :: forall r. IpeOut (PolyLine (Point 2 r)) Path r
ipePolyLine PolyLine (Point 2 r)
p = (PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (PathSegment r -> Path r)
-> (PolyLine (Point 2 r) -> PathSegment r)
-> PolyLine (Point 2 r)
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolyLine (Point 2 r) -> PathSegment r
forall r. PolyLine (Point 2 r) -> PathSegment r
PolyLineSegment (PolyLine (Point 2 r) -> Path r) -> PolyLine (Point 2 r) -> Path r
forall a b. (a -> b) -> a -> b
$ PolyLine (Point 2 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


-- | Renders an Ellipse to a Path
ipeEllipse :: IpeOut (Ellipse r) Path r
ipeEllipse :: forall r. 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

-- | Renders a circle to a Path
ipeCircle :: Radical r => IpeOut (Circle (Point 2 r)) Path r
ipeCircle :: forall r. Radical r => IpeOut (Circle (Point 2 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]
IpeOut (Ellipse r) Path r
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 (Point 2 r) -> Ellipse r)
-> Circle (Point 2 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 (Point 2 r) -> Ellipse r
forall r point.
(Radical r, Point_ point 2 r) =>
Circle point -> Ellipse r
circleToEllipse

-- | Renders a Disk to a Path
ipeDisk   :: Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk :: forall r. Radical r => IpeOut (Disk (Point 2 r)) Path r
ipeDisk Disk (Point 2 r)
d = IpeOut (Circle (Point 2 r)) Path r
forall r. Radical r => IpeOut (Circle (Point 2 r)) Path r
ipeCircle (Disk (Point 2 r) -> Circle (Point 2 r)
forall point. Ball point -> Sphere point
MkSphere Disk (Point 2 r)
d) (Path r :+ Attributes (AttrMapSym1 r) (AttributesOf Path))
-> Attributes (AttrMapSym1 r) (AttributesOf Path)
-> Path r :+ Attributes (AttrMapSym1 r) (AttributesOf Path)
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")

-- | Renders a Bezier curve to a Path
ipeBezier :: IpeOut (CubicBezier (Point 2 r)) Path r
ipeBezier :: forall r. IpeOut (CubicBezier (Point 2 r)) Path r
ipeBezier CubicBezier (Point 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
$ CubicBezier (Point 2 r) -> PathSegment r
forall r. CubicBezier (Point 2 r) -> PathSegment r
CubicBezierSegment CubicBezier (Point 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 :: forall r. PathSegment r -> Path r
path = Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (Seq (PathSegment r) -> Path r)
-> (PathSegment r -> Seq (PathSegment r))
-> PathSegment r
-> Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathSegment r -> Seq (PathSegment r)
forall a. a -> Seq a
Seq.singleton

-- | Construct a PolyLine path segment
pathSegment :: (LineSegment_ lineSegment point, Point_ point 2 r)
            => lineSegment -> PathSegment r
pathSegment :: forall lineSegment point r.
(LineSegment_ lineSegment point, Point_ point 2 r) =>
lineSegment -> PathSegment r
pathSegment = PolyLine (Point 2 r) -> PathSegment r
forall r. PolyLine (Point 2 r) -> PathSegment r
PolyLineSegment (PolyLine (Point 2 r) -> PathSegment r)
-> (lineSegment -> PolyLine (Point 2 r))
-> lineSegment
-> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> Point 2 r)
-> PolyLineF NonEmptyVector point -> PolyLine (Point 2 r)
forall a b.
(a -> b)
-> PolyLineF NonEmptyVector a -> PolyLineF NonEmptyVector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (point -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) (PolyLineF NonEmptyVector point -> PolyLine (Point 2 r))
-> (lineSegment -> PolyLineF NonEmptyVector point)
-> lineSegment
-> PolyLine (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. lineSegment -> PolyLineF NonEmptyVector point
forall {b} {s}.
(NumType (Vertex b) ~ NumType b,
 Dimension (Vertex b) ~ Dimension b,
 ConstructablePolyLine_ b (Vertex b), HasStart s (Vertex b),
 HasEnd s (Vertex b),
 Point_ (Vertex b) (Dimension b) (NumType b)) =>
s -> b
lineSegmentToPolyLine
  where
    lineSegmentToPolyLine :: s -> b
lineSegmentToPolyLine s
s = NonEmpty (Vertex b) -> b
forall polyLine point (f :: * -> *).
(ConstructablePolyLine_ polyLine point, Foldable1 f) =>
f point -> polyLine
forall (f :: * -> *). Foldable1 f => f (Vertex b) -> b
polyLineFromPoints (NonEmpty (Vertex b) -> b)
-> ([Vertex b] -> NonEmpty (Vertex b)) -> [Vertex b] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vertex b] -> NonEmpty (Vertex b)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([Vertex b] -> b) -> [Vertex b] -> b
forall a b. (a -> b) -> a -> b
$ [s
ss -> Getting (Vertex b) s (Vertex b) -> Vertex b
forall s a. s -> Getting a s a -> a
^.Getting (Vertex b) s (Vertex b)
forall seg p. HasStart seg p => Lens' seg p
Lens' s (Vertex b)
start, s
ss -> Getting (Vertex b) s (Vertex b) -> Vertex b
forall s a. s -> Getting a s a -> a
^.Getting (Vertex b) s (Vertex b)
forall seg p. HasEnd seg p => Lens' seg p
Lens' s (Vertex b)
end]

-- | Render as a polygon
ipePolygon    :: Polygon_ polygon point r => IpeOut polygon Path r
ipePolygon :: forall polygon point r.
Polygon_ polygon point r =>
IpeOut polygon Path r
ipePolygon polygon
pg = Seq (PathSegment r) -> Path r
forall r. Seq (PathSegment r) -> Path r
Path (PathSegment r
outer PathSegment r -> Seq (PathSegment r) -> Seq (PathSegment r)
forall s a. Cons s s a a => a -> s -> s
<| Seq (PathSegment r)
inners) 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
  where
    outer :: PathSegment r
outer  = polygon -> PathSegment r
forall polygon point r.
(HasOuterBoundary polygon, Point_ point 2 r,
 Vertex polygon ~ point) =>
polygon -> PathSegment r
toPolygonPathSegment polygon
pg
    inners :: Seq (PathSegment r)
inners = SimplePolygonF (HoleF polygon) point -> PathSegment r
forall polygon point r.
(HasOuterBoundary polygon, Point_ point 2 r,
 Vertex polygon ~ point) =>
polygon -> PathSegment r
toPolygonPathSegment (SimplePolygonF (HoleF polygon) point -> PathSegment r)
-> Seq (SimplePolygonF (HoleF polygon) point)
-> Seq (PathSegment r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Seq (SimplePolygonF (HoleF polygon) point))
  polygon
  (SimplePolygonF (HoleF polygon) point)
-> polygon -> Seq (SimplePolygonF (HoleF polygon) point)
forall {a} {s}. Getting (Seq a) s a -> s -> Seq a
toSequenceOf Getting
  (Seq (SimplePolygonF (HoleF polygon) point))
  polygon
  (SimplePolygonF (HoleF polygon) point)
(Hole polygon
 -> Const
      (Seq (SimplePolygonF (HoleF polygon) point)) (Hole polygon))
-> polygon
-> Const (Seq (SimplePolygonF (HoleF polygon) point)) polygon
forall polygon.
HasHoles polygon =>
IndexedTraversal' (HoleIx polygon) polygon (Hole polygon)
IndexedTraversal' (HoleIx polygon) polygon (Hole polygon)
holes polygon
pg
    toSequenceOf :: Getting (Seq a) s a -> s -> Seq a
toSequenceOf Getting (Seq a) s a
l = Getting (Seq a) s a -> (a -> Seq a) -> s -> Seq a
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (Seq a) s a
l a -> Seq a
forall a. a -> Seq a
Seq.singleton

-- | Helper type to build a path segment
toPolygonPathSegment :: ( HasOuterBoundary polygon, Point_ point 2 r, Vertex polygon ~ point)
                     => polygon -> PathSegment r
toPolygonPathSegment :: forall polygon point r.
(HasOuterBoundary polygon, Point_ point 2 r,
 Vertex polygon ~ point) =>
polygon -> PathSegment r
toPolygonPathSegment = Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath Orientation
AsIs (SimplePolygon (Point 2 r) -> PathSegment r)
-> (polygon -> SimplePolygon (Point 2 r))
-> polygon
-> PathSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r) -> SimplePolygon (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> SimplePolygon (Point 2 r)
uncheckedFromCCWPoints
                     (NonEmpty (Point 2 r) -> SimplePolygon (Point 2 r))
-> (polygon -> NonEmpty (Point 2 r))
-> polygon
-> SimplePolygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (NonEmptyDList (Point 2 r)) polygon (Point 2 r)
-> polygon -> NonEmpty (Point 2 r)
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf ((point -> Const (NonEmptyDList (Point 2 r)) point)
-> polygon -> Const (NonEmptyDList (Point 2 r)) polygon
(Vertex polygon
 -> Const (NonEmptyDList (Point 2 r)) (Vertex polygon))
-> polygon -> Const (NonEmptyDList (Point 2 r)) polygon
forall polygon.
HasOuterBoundary polygon =>
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
IndexedTraversal1' (VertexIx polygon) polygon (Vertex polygon)
outerBoundary((point -> Const (NonEmptyDList (Point 2 r)) point)
 -> polygon -> Const (NonEmptyDList (Point 2 r)) polygon)
-> ((Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
    -> point -> Const (NonEmptyDList (Point 2 r)) point)
-> Getting (NonEmptyDList (Point 2 r)) polygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
-> point -> Const (NonEmptyDList (Point 2 r)) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)
  -- this feels a bit silly, I feel we should directly be able to construct
  -- the polygon just using the outerBoundaryFold, but whatever.

-- | Draw a polygon
ipeSimplePolygon    :: (SimplePolygon_ simplePolygon point r)
                    => IpeOut simplePolygon Path r
ipeSimplePolygon :: forall simplePolygon point r.
SimplePolygon_ simplePolygon point r =>
IpeOut simplePolygon Path r
ipeSimplePolygon simplePolygon
pg = PathSegment r -> Path r
forall r. PathSegment r -> Path r
path (Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
forall r. Orientation -> SimplePolygon (Point 2 r) -> PathSegment r
PolygonPath Orientation
AsIs SimplePolygon (Point 2 r)
pg') 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
  where
    pg' :: SimplePolygon (Point 2 r)
pg' = NonEmpty (Point 2 r) -> SimplePolygon (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> SimplePolygon (Point 2 r)
uncheckedFromCCWPoints (NonEmpty (Point 2 r) -> SimplePolygon (Point 2 r))
-> NonEmpty (Point 2 r) -> SimplePolygon (Point 2 r)
forall a b. (a -> b) -> a -> b
$ Getting (NonEmptyDList (Point 2 r)) simplePolygon (Point 2 r)
-> simplePolygon -> NonEmpty (Point 2 r)
forall a s. Getting (NonEmptyDList a) s a -> s -> NonEmpty a
toNonEmptyOf ((point -> Const (NonEmptyDList (Point 2 r)) point)
-> simplePolygon -> Const (NonEmptyDList (Point 2 r)) simplePolygon
(Vertex simplePolygon
 -> Const (NonEmptyDList (Point 2 r)) (Vertex simplePolygon))
-> simplePolygon -> Const (NonEmptyDList (Point 2 r)) simplePolygon
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx simplePolygon)
  simplePolygon
  simplePolygon
  (Vertex simplePolygon)
  (Vertex simplePolygon)
vertices((point -> Const (NonEmptyDList (Point 2 r)) point)
 -> simplePolygon
 -> Const (NonEmptyDList (Point 2 r)) simplePolygon)
-> ((Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
    -> point -> Const (NonEmptyDList (Point 2 r)) point)
-> Getting (NonEmptyDList (Point 2 r)) simplePolygon (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (NonEmptyDList (Point 2 r)) (Point 2 r))
-> point -> Const (NonEmptyDList (Point 2 r)) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) simplePolygon
pg
  -- TODO, maybe write a 'toNonEmptyVectorOf' to avoid copying

-- | Draw a polygon
ipeSimplePolygon'    :: Foldable1 f => IpeOut (SimplePolygonF f (Point 2 r)) Path r
ipeSimplePolygon' :: forall (f :: * -> *) r.
Foldable1 f =>
IpeOut (SimplePolygonF f (Point 2 r)) Path r
ipeSimplePolygon' SimplePolygonF f (Point 2 r)
pg = Prism
  (Path r)
  (Path r)
  (SimplePolygon (Point 2 r))
  (SimplePolygonF f (Point 2 r))
-> SimplePolygonF f (Point 2 r) -> Path r
forall s t a b. Prism s t a b -> b -> t
review' p (SimplePolygon (Point 2 r)) (f (SimplePolygonF f (Point 2 r)))
-> p (Path r) (f (Path r))
forall (f :: * -> *) r.
Foldable1 f =>
Prism
  (Path r)
  (Path r)
  (SimplePolygon (Point 2 r))
  (SimplePolygonF f (Point 2 r))
Prism
  (Path r)
  (Path r)
  (SimplePolygon (Point 2 r))
  (SimplePolygonF f (Point 2 r))
_asSimplePolygon SimplePolygonF f (Point 2 r)
pg 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

-- | A slightly more general version of review that allows the s and t to differ.
-- (and in some sense it is less general, since I don't care about monad constraints here)
review'   :: forall s t a b. Prism s t a b -> b -> t
review' :: forall s t a b. Prism s t a b -> b -> t
review' Prism s t a b
p = AReview t b -> b -> t
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review (AReview t b -> b -> t) -> AReview t b -> b -> t
forall a b. (a -> b) -> a -> b
$ Optic Tagged Identity s t a b -> AReview t b
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Bifunctor p, Functor f) =>
Optic Tagged Identity s t a b -> Optic' p f t b
reviewing Optic Tagged Identity s t a b
Prism s t a b
p
-- alternatively:
-- review' p = withPrism p (\f _ -> f)


-- | Draw a Rectangle
ipeRectangle   :: Num r => IpeOut (Rectangle (Point 2 r)) Path r
ipeRectangle :: forall r. Num r => IpeOut (Rectangle (Point 2 r)) Path r
ipeRectangle Rectangle (Point 2 r)
r = forall (f :: * -> *) r.
Foldable1 f =>
IpeOut (SimplePolygonF f (Point 2 r)) Path r
ipeSimplePolygon' @NonEmptyVector IpeOut (SimplePolygonF NonEmptyVector (Point 2 r)) Path r
-> ([Point 2 r] -> SimplePolygonF NonEmptyVector (Point 2 r))
-> [Point 2 r]
-> IpeObject' Path r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r)
uncheckedFromCCWPoints (NonEmpty (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r))
-> ([Point 2 r] -> NonEmpty (Point 2 r))
-> [Point 2 r]
-> SimplePolygonF NonEmptyVector (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point 2 r] -> NonEmpty (Point 2 r)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
               ([Point 2 r] -> IpeObject' Path r)
-> [Point 2 r] -> IpeObject' Path r
forall a b. (a -> b) -> a -> b
$ [Point 2 r
tl,Point 2 r
tr,Point 2 r
br,Point 2 r
bl]
  where
    Corners Point 2 r
tl Point 2 r
tr Point 2 r
br Point 2 r
bl = Rectangle (Point 2 r) -> Corners (Point 2 r)
forall r rectangle point.
(Num r, Rectangle_ rectangle point, Point_ point 2 r) =>
rectangle -> Corners point
corners Rectangle (Point 2 r)
r

-- | Renders a polyline to a Path
ipeTriangle :: (Eq r, Num r) => IpeOut (Triangle (Point 2 r)) Path r
ipeTriangle :: forall r. (Eq r, Num r) => IpeOut (Triangle (Point 2 r)) Path r
ipeTriangle = forall (f :: * -> *) r.
Foldable1 f =>
IpeOut (SimplePolygonF f (Point 2 r)) Path r
ipeSimplePolygon' @NonEmptyVector (SimplePolygonF NonEmptyVector (Point 2 r)
 -> Path r
    :+ Attributes
         (AttrMapSym1 r)
         '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Fill, 'Dash,
            'Pen, 'LineCap, 'LineJoin, 'FillRule, 'Arrow, 'RArrow,
            'StrokeOpacity, 'Opacity, 'Tiling, 'Gradient])
-> (Triangle (Point 2 r)
    -> SimplePolygonF NonEmptyVector (Point 2 r))
-> Triangle (Point 2 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
. Triangle (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r)
forall simplePolygon point r (f :: * -> *).
(SimplePolygon_ simplePolygon point r, Foldable1 f) =>
f point -> simplePolygon
forall (f :: * -> *).
Foldable1 f =>
f (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r)
uncheckedFromCCWPoints
            (Triangle (Point 2 r) -> SimplePolygonF NonEmptyVector (Point 2 r))
-> (Triangle (Point 2 r) -> Triangle (Point 2 r))
-> Triangle (Point 2 r)
-> SimplePolygonF NonEmptyVector (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triangle (Point 2 r) -> Triangle (Point 2 r)
forall r point triangle.
(Num r, Eq r, Point_ point 2 r, Triangle_ triangle point) =>
triangle -> triangle
toCounterClockwiseTriangle


-- | Default rendering of halfplanes
ipeHalfPlane :: (Show r, Fractional r, Ord r)
             => IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlane :: forall r.
(Show r, Fractional r, Ord r) =>
IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlane = Rectangle (Point 2 r)
-> IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
forall r.
(Ord r, Fractional r, Show r) =>
Rectangle (Point 2 r)
-> IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlaneIn Rectangle (Point 2 r)
forall r. Num r => Rectangle (Point 2 r)
defaultBox

-- | Draw a halfplane in the given rectangle.
--
-- We draw both the border (in black) and the interior (20% transparant gray) of the halfpace
ipeHalfPlaneIn            :: (Ord r, Fractional r, Show r)
                          => Rectangle (Point 2 r)
                          -> IpeColor r
                          -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlaneIn :: forall r.
(Ord r, Fractional r, Show r) =>
Rectangle (Point 2 r)
-> IpeColor r -> IpeOut (HalfSpaceF (LinePV 2 r)) Group r
ipeHalfPlaneIn Rectangle (Point 2 r)
rect' IpeColor r
c HalfSpaceF (LinePV 2 r)
hl = case HalfSpaceF (LinePV 2 r)
hl HalfSpaceF (LinePV 2 r)
-> Rectangle (Point 2 r)
-> Intersection (HalfSpaceF (LinePV 2 r)) (Rectangle (Point 2 r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle (Point 2 r)
rect' of
    Maybe
  (PossiblyDegenerateSimplePolygon
     (Point 2 r) (ConvexPolygon (Point 2 r)))
Intersection (HalfSpaceF (LinePV 2 r)) (Rectangle (Point 2 r))
Nothing -> IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup [] -- this should not really happen I guess?
    Just PossiblyDegenerateSimplePolygon
  (Point 2 r) (ConvexPolygon (Point 2 r))
is -> case PossiblyDegenerateSimplePolygon
  (Point 2 r) (ConvexPolygon (Point 2 r))
is of
      ActualPolygon ConvexPolygon (Point 2 r)
interior -> IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup [ IpeObject' Path r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' Path r -> IpeObject r)
-> IpeObject' Path r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ IpeOut (ConvexPolygon (Point 2 r)) Path r
forall simplePolygon point r.
SimplePolygon_ simplePolygon point r =>
IpeOut simplePolygon Path r
ipeSimplePolygon ConvexPolygon (Point 2 r)
interior
                                              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 Apply (AttrMapSym1 r) 'Fill
IpeColor r
c
                                              IpeObject' Path r -> IpeAttributes Path r -> IpeObject' Path r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! SAttributeUniverse 'Opacity
-> Apply (AttrMapSym1 r) 'Opacity
-> 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 'Opacity
SOpacity (String -> Text
Text.pack String
"20%")
                                         , IpeObject r
boundary
                                         ]
      PossiblyDegenerateSimplePolygon
  (Point 2 r) (ConvexPolygon (Point 2 r))
_                      -> IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup [ IpeObject r
boundary ]
  where
    boundary :: IpeObject r
boundary = IpeObject' Path r -> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO (IpeObject' Path r -> IpeObject r)
-> IpeObject' Path r -> IpeObject r
forall a b. (a -> b) -> a -> b
$ Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
forall r.
(Ord r, Fractional r, Show r) =>
Rectangle (Point 2 r) -> IpeOut (LinePV 2 r) Path r
ipeLineIn Rectangle (Point 2 r)
rect' (HalfSpaceF (LinePV 2 r)
hlHalfSpaceF (LinePV 2 r)
-> Getting (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) (LinePV 2 r)
-> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.(BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r
 -> Const
      (LinePV 2 r) (BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r))
-> HalfSpaceF (LinePV 2 r)
-> Const (LinePV 2 r) (HalfSpaceF (LinePV 2 r))
Getting (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) (LinePV 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens'
  (HalfSpaceF (LinePV 2 r))
  (BoundingHyperPlane (HalfSpaceF (LinePV 2 r)) 2 r)
boundingHyperPlane)


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

ipeGroup    :: Foldable f => IpeOut (f (IpeObject r)) Group r
ipeGroup :: forall (f :: * -> *) r.
Foldable f =>
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 a. f a -> [a]
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

-- | Type representing a single line of latex
type InlineLaTeX = Text

-- | Creates an text label
ipeLabel            :: IpeOut (InlineLaTeX :+ Point 2 r) TextLabel r
ipeLabel :: forall r. 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
     '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
        'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
-> TextLabel r
   :+ Attributes'
        r
        '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
           'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
forall core extra. core -> extra -> core :+ extra
:+ Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
     'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
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 :: forall lbl g r (i :: * -> *).
(Show lbl, NumType g ~ r, ToObject i) =>
(g -> Point 2 r) -> IpeOut g i r -> IpeOut (g :+ lbl) Group r
labelled = IpeAttributes TextLabel r
-> (g -> PointF (Vector 2 r))
-> (g -> i r :+ Attributes (AttrMapSym1 r) (AttributesOf i))
-> (g :+ lbl)
-> Group r :+ Attributes (AttrMapSym1 r) (AttributesOf Group)
forall lbl g r (i :: * -> *).
(Show lbl, NumType g ~ r, ToObject i) =>
IpeAttributes TextLabel r
-> (g -> Point 2 r) -> IpeOut g i r -> IpeOut (g :+ lbl) Group r
labelledWith Attributes'
  r
  '[ 'Layer, 'Matrix, 'Pin, 'Transformations, 'Stroke, 'Size, 'Width,
     'Height, 'Depth, 'VAlign, 'HAlign, 'Style, 'Opacity]
IpeAttributes TextLabel r
forall a. Monoid a => a
mempty

-- | Annotate an IpeOut with a label
labelledWith                      :: (Show lbl, NumType g ~ r, ToObject i)
                                  => IpeAttributes TextLabel r -- ^ attributes for the label
                                  -> (g -> Point 2 r) -- ^ where to place the label
                                  -> IpeOut g i r     -- ^ how to draw the geometric object
                                  -> IpeOut (g :+ lbl) Group r
labelledWith :: forall lbl g r (i :: * -> *).
(Show lbl, NumType g ~ r, ToObject i) =>
IpeAttributes TextLabel r
-> (g -> Point 2 r) -> IpeOut g i r -> IpeOut (g :+ lbl) Group r
labelledWith IpeAttributes TextLabel r
ats 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 ((Text -> Text
toInlineLatex (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ lbl -> Text
forall a. Show a => a -> Text
Text.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) IpeObject' TextLabel r
-> IpeAttributes TextLabel r -> IpeObject' TextLabel r
forall (i :: * -> *) r.
IpeObject' i r -> IpeAttributes i r -> IpeObject' i r
! IpeAttributes TextLabel r
ats
                                     ]

-- | Convert a text into a valid piece of inline latex
toInlineLatex :: Text -> InlineLaTeX
toInlineLatex :: Text -> Text
toInlineLatex = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"_" (Text
"\\_")
-- for the moment we just make sure that our underscores get properly escaped