{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path
-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Paths in two dimensions are special since we may stroke them to
-- create a 2D diagram, and (eventually) perform operations such as
-- intersection and union.  They also have a trace, whereas paths in
-- higher dimensions do not.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Path
  ( -- * Constructing path-based diagrams

    stroke, stroke'
  , strokePath, strokeP, strokePath', strokeP'
  , strokeTrail, strokeT, strokeTrail', strokeT'
  , strokeLine, strokeLoop
  , strokeLocTrail, strokeLocT, strokeLocLine, strokeLocLoop

    -- ** Stroke options

  , FillRule(..)
  , getFillRule, fillRule, _fillRule
  , StrokeOpts(..), vertexNames, queryFillRule

    -- ** Inside/outside testing

  , Crossings (..)
  , isInsideWinding
  , isInsideEvenOdd

    -- * Clipping

  , Clip(..), _Clip, _clip
  , clipBy, clipTo, clipped

    -- * Intersections

  , intersectPoints, intersectPoints'
  , intersectPointsP, intersectPointsP'
  , intersectPointsT, intersectPointsT'
  ) where

import           Control.Applicative       (liftA2)
import           Control.Lens              hiding (at, transform)
import qualified Data.Foldable             as F
import           Data.Semigroup
import           Data.Typeable

import           Data.Default.Class

import           Diagrams.Angle
import           Diagrams.Combinators      (withEnvelope, withTrace)
import           Diagrams.Core
import           Diagrams.Core.Trace
import           Diagrams.Located          (Located, mapLoc, unLoc)
import           Diagrams.Parametric
import           Diagrams.Path
import           Diagrams.Query
import           Diagrams.Segment
import           Diagrams.Solve.Polynomial
import           Diagrams.Trail
import           Diagrams.TrailLike
import           Diagrams.TwoD.Segment
import           Diagrams.TwoD.Types
import           Diagrams.TwoD.Vector
import           Diagrams.Util             (tau)

import           Linear.Affine
import           Linear.Vector

------------------------------------------------------------
--  Trail and path traces  ---------------------------------
------------------------------------------------------------

-- Only 2D trails and paths have a trace.

-- XXX can the efficiency of this be improved?  See the comment in
-- Diagrams.Path on the Enveloped instance for Trail.
instance RealFloat n => Traced (Trail V2 n) where
  getTrace :: Trail V2 n -> Trace (V (Trail V2 n)) (N (Trail V2 n))
getTrace = (Trail' Line V2 n -> Trace V2 n) -> Trail V2 n -> Trace V2 n
forall (v :: * -> *) n r.
(Metric v, OrderedField n) =>
(Trail' Line v n -> r) -> Trail v n -> r
withLine ((Trail' Line V2 n -> Trace V2 n) -> Trail V2 n -> Trace V2 n)
-> (Trail' Line V2 n -> Trace V2 n) -> Trail V2 n -> Trace V2 n
forall a b. (a -> b) -> a -> b
$
      (Segment Closed V2 n -> Trace V2 n -> Trace V2 n)
-> Trace V2 n -> [Segment Closed V2 n] -> Trace V2 n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        (\Segment Closed V2 n
seg Trace V2 n
bds -> V2 n -> Trace V2 n -> Trace V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, HasOrigin t) =>
v n -> t -> t
moveOriginBy (V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (V2 n -> V2 n)
-> (Segment Closed V2 n -> V2 n) -> Segment Closed V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment Closed V2 n -> V2 n
forall p. EndValues p => p -> Codomain p (N p)
atEnd (Segment Closed V2 n -> V2 n) -> Segment Closed V2 n -> V2 n
forall a b. (a -> b) -> a -> b
$ Segment Closed V2 n
seg) Trace V2 n
bds Trace V2 n -> Trace V2 n -> Trace V2 n
forall a. Semigroup a => a -> a -> a
<> Segment Closed V2 n
-> Trace (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace Segment Closed V2 n
seg)
        Trace V2 n
forall a. Monoid a => a
mempty
    ([Segment Closed V2 n] -> Trace V2 n)
-> (Trail' Line V2 n -> [Segment Closed V2 n])
-> Trail' Line V2 n
-> Trace V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 n -> [Segment Closed V2 n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

instance RealFloat n => Traced (Path V2 n) where
  getTrace :: Path V2 n -> Trace (V (Path V2 n)) (N (Path V2 n))
getTrace = (Located (Trail V2 n) -> Trace V2 n)
-> [Located (Trail V2 n)] -> Trace V2 n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Located (Trail V2 n) -> Trace V2 n
forall a. Traced a => a -> Trace (V a) (N a)
getTrace ([Located (Trail V2 n)] -> Trace V2 n)
-> (Path V2 n -> [Located (Trail V2 n)]) -> Path V2 n -> Trace V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Path V2 n) -> Path V2 n)
-> Path V2 n -> Unwrapped (Path V2 n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Unwrapped (Path V2 n) -> Path V2 n
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path

------------------------------------------------------------
--  Constructing path-based diagrams  ----------------------
------------------------------------------------------------

-- | Enumeration of algorithms or \"rules\" for determining which
--   points lie in the interior of a (possibly self-intersecting)
--   path.
data FillRule
  = Winding  -- ^ Interior points are those with a nonzero
             --   /winding/ /number/.  See
             --   <http://en.wikipedia.org/wiki/Nonzero-rule>.
  | EvenOdd  -- ^ Interior points are those where a ray
             --   extended infinitely in a particular direction crosses
             --   the path an odd number of times. See
             --   <http://en.wikipedia.org/wiki/Even-odd_rule>.
    deriving (Int -> FillRule -> ShowS
[FillRule] -> ShowS
FillRule -> String
(Int -> FillRule -> ShowS)
-> (FillRule -> String) -> ([FillRule] -> ShowS) -> Show FillRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillRule] -> ShowS
$cshowList :: [FillRule] -> ShowS
show :: FillRule -> String
$cshow :: FillRule -> String
showsPrec :: Int -> FillRule -> ShowS
$cshowsPrec :: Int -> FillRule -> ShowS
Show, Typeable, FillRule -> FillRule -> Bool
(FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> Bool) -> Eq FillRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillRule -> FillRule -> Bool
$c/= :: FillRule -> FillRule -> Bool
== :: FillRule -> FillRule -> Bool
$c== :: FillRule -> FillRule -> Bool
Eq, Eq FillRule
Eq FillRule
-> (FillRule -> FillRule -> Ordering)
-> (FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> Bool)
-> (FillRule -> FillRule -> FillRule)
-> (FillRule -> FillRule -> FillRule)
-> Ord FillRule
FillRule -> FillRule -> Bool
FillRule -> FillRule -> Ordering
FillRule -> FillRule -> FillRule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FillRule -> FillRule -> FillRule
$cmin :: FillRule -> FillRule -> FillRule
max :: FillRule -> FillRule -> FillRule
$cmax :: FillRule -> FillRule -> FillRule
>= :: FillRule -> FillRule -> Bool
$c>= :: FillRule -> FillRule -> Bool
> :: FillRule -> FillRule -> Bool
$c> :: FillRule -> FillRule -> Bool
<= :: FillRule -> FillRule -> Bool
$c<= :: FillRule -> FillRule -> Bool
< :: FillRule -> FillRule -> Bool
$c< :: FillRule -> FillRule -> Bool
compare :: FillRule -> FillRule -> Ordering
$ccompare :: FillRule -> FillRule -> Ordering
$cp1Ord :: Eq FillRule
Ord)

instance AttributeClass FillRule
instance Semigroup FillRule where
  FillRule
_ <> :: FillRule -> FillRule -> FillRule
<> FillRule
b = FillRule
b

instance Default FillRule where
  def :: FillRule
def = FillRule
Winding

-- | A record of options that control how a path is stroked.
--   @StrokeOpts@ is an instance of 'Default', so a @StrokeOpts@
--   records can be created using @'with' { ... }@ notation.
data StrokeOpts a
  = StrokeOpts
    { StrokeOpts a -> [[a]]
_vertexNames   :: [[a]]

    , StrokeOpts a -> FillRule
_queryFillRule :: FillRule

    }

makeLensesWith (generateSignatures .~ False $ lensRules) ''StrokeOpts

-- | Atomic names that should be assigned to the vertices of the path so that
--   they can be referenced later.  If there are not enough names, the extra
--   vertices are not assigned names; if there are too many, the extra names
--   are ignored.  Note that this is a /list of lists/ of names, since paths
--   can consist of multiple trails.  The first list of names are assigned to
--   the vertices of the first trail, the second list to the second trail, and
--   so on.
--
--   The default value is the empty list.

vertexNames :: Lens (StrokeOpts a) (StrokeOpts a') [[a]] [[a']]

-- | The fill rule used for determining which points are inside the path.
--   The default is 'Winding'.  NOTE: for now, this only affects the resulting
--   diagram's 'Query', /not/ how it will be drawn!  To set the fill rule
--   determining how it is to be drawn, use the 'fillRule' function.
queryFillRule :: Lens' (StrokeOpts a) FillRule

instance Default (StrokeOpts a) where
  def :: StrokeOpts a
def = StrokeOpts :: forall a. [[a]] -> FillRule -> StrokeOpts a
StrokeOpts
        { _vertexNames :: [[a]]
_vertexNames    = []
        , _queryFillRule :: FillRule
_queryFillRule = FillRule
forall a. Default a => a
def
        }

-- | Convert a 'ToPath' object into a diagram.  The resulting diagram has the
--   names 0, 1, ... assigned to each of the path's vertices.
--
--   See also 'stroke'', which takes an extra options record allowing
--   its behaviour to be customized.
--
-- @
-- 'stroke' :: 'Path' 'V2' 'Double'                  -> 'Diagram' b
-- 'stroke' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Diagram' b
-- 'stroke' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Diagram' b
-- 'stroke' :: 'Located' ('Trail'' 'Line' 'V2' 'Double') -> 'Diagram' b
-- @
stroke :: (InSpace V2 n t, ToPath t, TypeableFloat n, Renderable (Path V2 n) b)
       => t -> QDiagram b V2 n Any
stroke :: t -> QDiagram b V2 n Any
stroke = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (Path V2 n -> QDiagram b V2 n Any)
-> (t -> Path V2 n) -> t -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Path V2 n
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath

-- | A variant of 'stroke' that takes an extra record of options to
--   customize its behaviour.  In particular:
--
--     * Names can be assigned to the path's vertices
--
--   'StrokeOpts' is an instance of 'Default', so @stroke' ('with' &
--   ... )@ syntax may be used.
stroke' :: (InSpace V2 n t, ToPath t, TypeableFloat n, Renderable (Path V2 n) b, IsName a)
       => StrokeOpts a -> t -> QDiagram b V2 n Any
stroke' :: StrokeOpts a -> t -> QDiagram b V2 n Any
stroke' StrokeOpts a
opts = StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
forall n b a.
(TypeableFloat n, Renderable (Path V2 n) b, IsName a) =>
StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokeP' StrokeOpts a
opts (Path V2 n -> QDiagram b V2 n Any)
-> (t -> Path V2 n) -> t -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Path V2 n
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath

-- | 'stroke' specialised to 'Path'.
strokeP :: (TypeableFloat n, Renderable (Path V2 n) b)
        => Path V2 n -> QDiagram b V2 n Any
strokeP :: Path V2 n -> QDiagram b V2 n Any
strokeP = StrokeOpts () -> Path V2 n -> QDiagram b V2 n Any
forall n b a.
(TypeableFloat n, Renderable (Path V2 n) b, IsName a) =>
StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokeP' (StrokeOpts ()
forall a. Default a => a
def :: StrokeOpts ())

-- | 'stroke' specialised to 'Path'.
strokePath :: (TypeableFloat n, Renderable (Path V2 n) b)
        => Path V2 n -> QDiagram b V2 n Any
strokePath :: Path V2 n -> QDiagram b V2 n Any
strokePath = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP

instance (TypeableFloat n, Renderable (Path V2 n) b)
    => TrailLike (QDiagram b V2 n Any) where
  trailLike :: Located (Trail (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any)))
-> QDiagram b V2 n Any
trailLike = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (Path V2 n -> QDiagram b V2 n Any)
-> (Located (Trail V2 n) -> Path V2 n)
-> Located (Trail V2 n)
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike

-- | 'stroke'' specialised to 'Path'.
strokeP' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)
    => StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokeP' :: StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokeP' StrokeOpts a
opts Path V2 n
path
  | [Located (Trail V2 n)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Path V2 n
pLines Path V2 n
-> Getting
     [Located (Trail V2 n)] (Path V2 n) [Located (Trail V2 n)]
-> [Located (Trail V2 n)]
forall s a. s -> Getting a s a -> a
^. Getting [Located (Trail V2 n)] (Path V2 n) [Located (Trail V2 n)]
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') = Path V2 n -> QDiagram b V2 n Any
mkP Path V2 n
pLoops
  | [Located (Trail V2 n)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Path V2 n
pLoops Path V2 n
-> Getting
     [Located (Trail V2 n)] (Path V2 n) [Located (Trail V2 n)]
-> [Located (Trail V2 n)]
forall s a. s -> Getting a s a -> a
^. Getting [Located (Trail V2 n)] (Path V2 n) [Located (Trail V2 n)]
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped') = Path V2 n -> QDiagram b V2 n Any
mkP Path V2 n
pLines
  | Bool
otherwise                  = Path V2 n -> QDiagram b V2 n Any
mkP Path V2 n
pLines QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> Path V2 n -> QDiagram b V2 n Any
mkP Path V2 n
pLoops
  where
    (Path V2 n
pLines,Path V2 n
pLoops) = (Located (Trail V2 n) -> Bool)
-> Path V2 n -> (Path V2 n, Path V2 n)
forall (v :: * -> *) n.
(Located (Trail v n) -> Bool) -> Path v n -> (Path v n, Path v n)
partitionPath (Trail V2 n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLine (Trail V2 n -> Bool)
-> (Located (Trail V2 n) -> Trail V2 n)
-> Located (Trail V2 n)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc) Path V2 n
path
    mkP :: Path V2 n -> QDiagram b V2 n Any
mkP Path V2 n
p
      = Prim b V2 n
-> Envelope V2 n
-> Trace V2 n
-> SubMap b V2 n Any
-> Query V2 n Any
-> QDiagram b V2 n Any
forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD (Path V2 n -> Prim b (V (Path V2 n)) (N (Path V2 n))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim Path V2 n
p)
         (Path V2 n -> Envelope (V (Path V2 n)) (N (Path V2 n))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope Path V2 n
p)
         (Path V2 n -> Trace (V (Path V2 n)) (N (Path V2 n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace Path V2 n
p)
         ([(a, Subdiagram b V2 n Any)] -> SubMap b V2 n Any
forall a b (v :: * -> *) n m.
IsName a =>
[(a, Subdiagram b v n m)] -> SubMap b v n m
fromNames ([(a, Subdiagram b V2 n Any)] -> SubMap b V2 n Any)
-> ([[(a, Subdiagram b V2 n Any)]] -> [(a, Subdiagram b V2 n Any)])
-> [[(a, Subdiagram b V2 n Any)]]
-> SubMap b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(a, Subdiagram b V2 n Any)]] -> [(a, Subdiagram b V2 n Any)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, Subdiagram b V2 n Any)]] -> SubMap b V2 n Any)
-> [[(a, Subdiagram b V2 n Any)]] -> SubMap b V2 n Any
forall a b. (a -> b) -> a -> b
$
           ([a] -> [Subdiagram b V2 n Any] -> [(a, Subdiagram b V2 n Any)])
-> [[a]]
-> [[Subdiagram b V2 n Any]]
-> [[(a, Subdiagram b V2 n Any)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [Subdiagram b V2 n Any] -> [(a, Subdiagram b V2 n Any)]
forall a b. [a] -> [b] -> [(a, b)]
zip (StrokeOpts a
optsStrokeOpts a -> Getting [[a]] (StrokeOpts a) [[a]] -> [[a]]
forall s a. s -> Getting a s a -> a
^.Getting [[a]] (StrokeOpts a) [[a]]
forall a a'. Lens (StrokeOpts a) (StrokeOpts a') [[a]] [[a']]
vertexNames) ((([Point V2 n] -> [Subdiagram b V2 n Any])
-> [[Point V2 n]] -> [[Subdiagram b V2 n Any]]
forall a b. (a -> b) -> [a] -> [b]
map (([Point V2 n] -> [Subdiagram b V2 n Any])
 -> [[Point V2 n]] -> [[Subdiagram b V2 n Any]])
-> ((Point V2 n -> Subdiagram b V2 n Any)
    -> [Point V2 n] -> [Subdiagram b V2 n Any])
-> (Point V2 n -> Subdiagram b V2 n Any)
-> [[Point V2 n]]
-> [[Subdiagram b V2 n Any]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point V2 n -> Subdiagram b V2 n Any)
-> [Point V2 n] -> [Subdiagram b V2 n Any]
forall a b. (a -> b) -> [a] -> [b]
map) Point V2 n -> Subdiagram b V2 n Any
forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
Point v n -> Subdiagram b v n m
subPoint (Path V2 n -> [[Point V2 n]]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> [[Point v n]]
pathVertices Path V2 n
p))
         )
         ((Point V2 n -> Any) -> Query V2 n Any
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point V2 n -> Any) -> Query V2 n Any)
-> (Point V2 n -> Any) -> Query V2 n Any
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any (Bool -> Any) -> (Point V2 n -> Bool) -> Point V2 n -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FillRule -> Path V2 n -> Point V2 n -> Bool
forall n.
RealFloat n =>
FillRule -> Path V2 n -> Point V2 n -> Bool
runFillRule (StrokeOpts a
optsStrokeOpts a
-> Getting FillRule (StrokeOpts a) FillRule -> FillRule
forall s a. s -> Getting a s a -> a
^.Getting FillRule (StrokeOpts a) FillRule
forall a. Lens' (StrokeOpts a) FillRule
queryFillRule)) Path V2 n
p)

-- | 'stroke'' specialised to 'Path'.
strokePath' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)
    => StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokePath' :: StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokePath' = StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
forall n b a.
(TypeableFloat n, Renderable (Path V2 n) b, IsName a) =>
StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
strokeP'

-- | 'stroke' specialised to 'Trail'.
strokeTrail :: (TypeableFloat n, Renderable (Path V2 n) b)
            => Trail V2 n -> QDiagram b V2 n Any
strokeTrail :: Trail V2 n -> QDiagram b V2 n Any
strokeTrail = Path V2 n -> QDiagram b V2 n Any
forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke (Path V2 n -> QDiagram b V2 n Any)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail

-- | 'stroke' specialised to 'Trail'.
strokeT :: (TypeableFloat n, Renderable (Path V2 n) b)
        => Trail V2 n -> QDiagram b V2 n Any
strokeT :: Trail V2 n -> QDiagram b V2 n Any
strokeT = Trail V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail V2 n -> QDiagram b V2 n Any
strokeTrail

-- | A composition of 'stroke'' and 'pathFromTrail' for conveniently
--   converting a trail directly into a diagram.
strokeTrail' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)
             => StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
strokeTrail' :: StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
strokeTrail' StrokeOpts a
opts = StrokeOpts a -> Path V2 n -> QDiagram b V2 n Any
forall n t b a.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b, IsName a) =>
StrokeOpts a -> t -> QDiagram b V2 n Any
stroke' StrokeOpts a
opts (Path V2 n -> QDiagram b V2 n Any)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail

-- | Deprecated synonym for 'strokeTrail''.
strokeT' :: (TypeableFloat n, Renderable (Path V2 n) b, IsName a)
         => StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
strokeT' :: StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
strokeT' = StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
forall n b a.
(TypeableFloat n, Renderable (Path V2 n) b, IsName a) =>
StrokeOpts a -> Trail V2 n -> QDiagram b V2 n Any
strokeTrail'

-- | A composition of 'strokeT' and 'wrapLine' for conveniently
--   converting a line directly into a diagram.
strokeLine :: (TypeableFloat n, Renderable (Path V2 n) b)
           => Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine :: Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine = Trail V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail V2 n -> QDiagram b V2 n Any
strokeT (Trail V2 n -> QDiagram b V2 n Any)
-> (Trail' Line V2 n -> Trail V2 n)
-> Trail' Line V2 n
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine

-- | A composition of 'strokeT' and 'wrapLoop' for conveniently
--   converting a loop directly into a diagram.
strokeLoop :: (TypeableFloat n, Renderable (Path V2 n) b)
           => Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop :: Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop = Trail V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail V2 n -> QDiagram b V2 n Any
strokeT (Trail V2 n -> QDiagram b V2 n Any)
-> (Trail' Loop V2 n -> Trail V2 n)
-> Trail' Loop V2 n
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop

-- | A convenience function for converting a @Located Trail@ directly
--   into a diagram; @strokeLocTrail = stroke . trailLike@.
strokeLocTrail :: (TypeableFloat n, Renderable (Path V2 n) b)
               => Located (Trail V2 n) -> QDiagram b V2 n Any
strokeLocTrail :: Located (Trail V2 n) -> QDiagram b V2 n Any
strokeLocTrail = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (Path V2 n -> QDiagram b V2 n Any)
-> (Located (Trail V2 n) -> Path V2 n)
-> Located (Trail V2 n)
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike

-- | Deprecated synonym for 'strokeLocTrail'.
strokeLocT :: (TypeableFloat n, Renderable (Path V2 n) b)
           => Located (Trail V2 n) -> QDiagram b V2 n Any
strokeLocT :: Located (Trail V2 n) -> QDiagram b V2 n Any
strokeLocT = Located (Trail V2 n) -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Located (Trail V2 n) -> QDiagram b V2 n Any
strokeLocTrail

-- | A convenience function for converting a @Located@ line directly
--   into a diagram; @strokeLocLine = stroke . trailLike . mapLoc wrapLine@.
strokeLocLine :: (TypeableFloat n, Renderable (Path V2 n) b)
              => Located (Trail' Line V2 n) -> QDiagram b V2 n Any
strokeLocLine :: Located (Trail' Line V2 n) -> QDiagram b V2 n Any
strokeLocLine = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (Path V2 n -> QDiagram b V2 n Any)
-> (Located (Trail' Line V2 n) -> Path V2 n)
-> Located (Trail' Line V2 n)
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> Path V2 n)
-> (Located (Trail' Line V2 n) -> Located (Trail V2 n))
-> Located (Trail' Line V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Line V2 n -> Trail V2 n)
-> Located (Trail' Line V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine

-- | A convenience function for converting a @Located@ loop directly
--   into a diagram; @strokeLocLoop = stroke . trailLike . mapLoc wrapLoop@.
strokeLocLoop :: (TypeableFloat n, Renderable (Path V2 n) b)
              => Located (Trail' Loop V2 n) -> QDiagram b V2 n Any
strokeLocLoop :: Located (Trail' Loop V2 n) -> QDiagram b V2 n Any
strokeLocLoop = Path V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Path V2 n -> QDiagram b V2 n Any
strokeP (Path V2 n -> QDiagram b V2 n Any)
-> (Located (Trail' Loop V2 n) -> Path V2 n)
-> Located (Trail' Loop V2 n)
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> Path V2 n)
-> (Located (Trail' Loop V2 n) -> Located (Trail V2 n))
-> Located (Trail' Loop V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Loop V2 n -> Trail V2 n)
-> Located (Trail' Loop V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop

------------------------------------------------------------
--  Inside/outside testing
------------------------------------------------------------

runFillRule :: RealFloat n => FillRule -> Path V2 n -> Point V2 n -> Bool
runFillRule :: FillRule -> Path V2 n -> Point V2 n -> Bool
runFillRule FillRule
Winding = Path V2 n -> Point V2 n -> Bool
forall t. HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideWinding
runFillRule FillRule
EvenOdd = Path V2 n -> Point V2 n -> Bool
forall t. HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideEvenOdd

-- | Extract the fill rule from a 'FillRuleA' attribute.
getFillRule :: FillRule -> FillRule
getFillRule :: FillRule -> FillRule
getFillRule = FillRule -> FillRule
forall a. a -> a
id

-- | Specify the fill rule that should be used for determining which
--   points are inside a path.
fillRule :: HasStyle a => FillRule -> a -> a
fillRule :: FillRule -> a -> a
fillRule = FillRule -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the fill rule of a style.
_fillRule :: Lens' (Style V2 n) FillRule
_fillRule :: (FillRule -> f FillRule) -> Style V2 n -> f (Style V2 n)
_fillRule = (Maybe FillRule -> f (Maybe FillRule))
-> Style V2 n -> f (Style V2 n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe FillRule -> f (Maybe FillRule))
 -> Style V2 n -> f (Style V2 n))
-> ((FillRule -> f FillRule)
    -> Maybe FillRule -> f (Maybe FillRule))
-> (FillRule -> f FillRule)
-> Style V2 n
-> f (Style V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillRule -> Iso' (Maybe FillRule) FillRule
forall a. Eq a => a -> Iso' (Maybe a) a
non FillRule
forall a. Default a => a
def

-- | The sum of /signed/ crossings of a path as we travel in the
--   positive x direction from a given point.
--
--     - A point is filled according to the 'Winding' fill rule, if the
--       number of 'Crossings' is non-zero (see 'isInsideWinding').
--
--     - A point is filled according to the 'EvenOdd' fill rule, if the
--       number of 'Crossings' is odd (see 'isInsideEvenOdd').
--
--   This is the 'HasQuery' result for 'Path's, 'Located' 'Trail's and
--   'Located' 'Loops'.
--
-- @
-- 'sample' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Crossings'
-- 'sample' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Crossings'
-- 'sample' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Crossings'
-- @
--
--   Note that 'Line's have no inside or outside, so don't contribute
--   crossings
newtype Crossings = Crossings Int
  deriving (Int -> Crossings -> ShowS
[Crossings] -> ShowS
Crossings -> String
(Int -> Crossings -> ShowS)
-> (Crossings -> String)
-> ([Crossings] -> ShowS)
-> Show Crossings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Crossings] -> ShowS
$cshowList :: [Crossings] -> ShowS
show :: Crossings -> String
$cshow :: Crossings -> String
showsPrec :: Int -> Crossings -> ShowS
$cshowsPrec :: Int -> Crossings -> ShowS
Show, Crossings -> Crossings -> Bool
(Crossings -> Crossings -> Bool)
-> (Crossings -> Crossings -> Bool) -> Eq Crossings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Crossings -> Crossings -> Bool
$c/= :: Crossings -> Crossings -> Bool
== :: Crossings -> Crossings -> Bool
$c== :: Crossings -> Crossings -> Bool
Eq, Eq Crossings
Eq Crossings
-> (Crossings -> Crossings -> Ordering)
-> (Crossings -> Crossings -> Bool)
-> (Crossings -> Crossings -> Bool)
-> (Crossings -> Crossings -> Bool)
-> (Crossings -> Crossings -> Bool)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> Ord Crossings
Crossings -> Crossings -> Bool
Crossings -> Crossings -> Ordering
Crossings -> Crossings -> Crossings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Crossings -> Crossings -> Crossings
$cmin :: Crossings -> Crossings -> Crossings
max :: Crossings -> Crossings -> Crossings
$cmax :: Crossings -> Crossings -> Crossings
>= :: Crossings -> Crossings -> Bool
$c>= :: Crossings -> Crossings -> Bool
> :: Crossings -> Crossings -> Bool
$c> :: Crossings -> Crossings -> Bool
<= :: Crossings -> Crossings -> Bool
$c<= :: Crossings -> Crossings -> Bool
< :: Crossings -> Crossings -> Bool
$c< :: Crossings -> Crossings -> Bool
compare :: Crossings -> Crossings -> Ordering
$ccompare :: Crossings -> Crossings -> Ordering
$cp1Ord :: Eq Crossings
Ord, Integer -> Crossings
Crossings -> Crossings
Crossings -> Crossings -> Crossings
(Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings)
-> (Crossings -> Crossings)
-> (Crossings -> Crossings)
-> (Integer -> Crossings)
-> Num Crossings
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Crossings
$cfromInteger :: Integer -> Crossings
signum :: Crossings -> Crossings
$csignum :: Crossings -> Crossings
abs :: Crossings -> Crossings
$cabs :: Crossings -> Crossings
negate :: Crossings -> Crossings
$cnegate :: Crossings -> Crossings
* :: Crossings -> Crossings -> Crossings
$c* :: Crossings -> Crossings -> Crossings
- :: Crossings -> Crossings -> Crossings
$c- :: Crossings -> Crossings -> Crossings
+ :: Crossings -> Crossings -> Crossings
$c+ :: Crossings -> Crossings -> Crossings
Num, Int -> Crossings
Crossings -> Int
Crossings -> [Crossings]
Crossings -> Crossings
Crossings -> Crossings -> [Crossings]
Crossings -> Crossings -> Crossings -> [Crossings]
(Crossings -> Crossings)
-> (Crossings -> Crossings)
-> (Int -> Crossings)
-> (Crossings -> Int)
-> (Crossings -> [Crossings])
-> (Crossings -> Crossings -> [Crossings])
-> (Crossings -> Crossings -> [Crossings])
-> (Crossings -> Crossings -> Crossings -> [Crossings])
-> Enum Crossings
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Crossings -> Crossings -> Crossings -> [Crossings]
$cenumFromThenTo :: Crossings -> Crossings -> Crossings -> [Crossings]
enumFromTo :: Crossings -> Crossings -> [Crossings]
$cenumFromTo :: Crossings -> Crossings -> [Crossings]
enumFromThen :: Crossings -> Crossings -> [Crossings]
$cenumFromThen :: Crossings -> Crossings -> [Crossings]
enumFrom :: Crossings -> [Crossings]
$cenumFrom :: Crossings -> [Crossings]
fromEnum :: Crossings -> Int
$cfromEnum :: Crossings -> Int
toEnum :: Int -> Crossings
$ctoEnum :: Int -> Crossings
pred :: Crossings -> Crossings
$cpred :: Crossings -> Crossings
succ :: Crossings -> Crossings
$csucc :: Crossings -> Crossings
Enum, Num Crossings
Ord Crossings
Num Crossings
-> Ord Crossings -> (Crossings -> Rational) -> Real Crossings
Crossings -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Crossings -> Rational
$ctoRational :: Crossings -> Rational
$cp2Real :: Ord Crossings
$cp1Real :: Num Crossings
Real, Enum Crossings
Real Crossings
Real Crossings
-> Enum Crossings
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> Crossings)
-> (Crossings -> Crossings -> (Crossings, Crossings))
-> (Crossings -> Crossings -> (Crossings, Crossings))
-> (Crossings -> Integer)
-> Integral Crossings
Crossings -> Integer
Crossings -> Crossings -> (Crossings, Crossings)
Crossings -> Crossings -> Crossings
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Crossings -> Integer
$ctoInteger :: Crossings -> Integer
divMod :: Crossings -> Crossings -> (Crossings, Crossings)
$cdivMod :: Crossings -> Crossings -> (Crossings, Crossings)
quotRem :: Crossings -> Crossings -> (Crossings, Crossings)
$cquotRem :: Crossings -> Crossings -> (Crossings, Crossings)
mod :: Crossings -> Crossings -> Crossings
$cmod :: Crossings -> Crossings -> Crossings
div :: Crossings -> Crossings -> Crossings
$cdiv :: Crossings -> Crossings -> Crossings
rem :: Crossings -> Crossings -> Crossings
$crem :: Crossings -> Crossings -> Crossings
quot :: Crossings -> Crossings -> Crossings
$cquot :: Crossings -> Crossings -> Crossings
$cp2Integral :: Enum Crossings
$cp1Integral :: Real Crossings
Integral)

instance Semigroup Crossings where
  Crossings Int
a <> :: Crossings -> Crossings -> Crossings
<> Crossings Int
b = Int -> Crossings
Crossings (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)

instance Monoid Crossings where
  mempty :: Crossings
mempty  = Int -> Crossings
Crossings Int
0
  mappend :: Crossings -> Crossings -> Crossings
mappend = Crossings -> Crossings -> Crossings
forall a. Semigroup a => a -> a -> a
(<>)

instance RealFloat n => HasQuery (Located (Trail V2 n)) Crossings where
  getQuery :: Located (Trail V2 n)
-> Query
     (V (Located (Trail V2 n))) (N (Located (Trail V2 n))) Crossings
getQuery Located (Trail V2 n)
trail = (Point V2 n -> Crossings) -> Query V2 n Crossings
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point V2 n -> Crossings) -> Query V2 n Crossings)
-> (Point V2 n -> Crossings) -> Query V2 n Crossings
forall a b. (a -> b) -> a -> b
$ \Point V2 n
p -> Point V2 n -> Located (Trail V2 n) -> Crossings
forall n.
RealFloat n =>
Point V2 n -> Located (Trail V2 n) -> Crossings
trailCrossings Point V2 n
p Located (Trail V2 n)
trail

instance RealFloat n => HasQuery (Located (Trail' l V2 n)) Crossings where
  getQuery :: Located (Trail' l V2 n)
-> Query
     (V (Located (Trail' l V2 n)))
     (N (Located (Trail' l V2 n)))
     Crossings
getQuery Located (Trail' l V2 n)
trail' = Located (Trail V2 n)
-> Query
     (V (Located (Trail V2 n))) (N (Located (Trail V2 n))) Crossings
forall t m. HasQuery t m => t -> Query (V t) (N t) m
getQuery ((Trail' l V2 n -> Trail V2 n)
-> Located (Trail' l V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' l V2 n -> Trail V2 n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail Located (Trail' l V2 n)
trail')

instance RealFloat n => HasQuery (Path V2 n) Crossings where
  getQuery :: Path V2 n -> Query (V (Path V2 n)) (N (Path V2 n)) Crossings
getQuery = Getting (Query V2 n Crossings) (Path V2 n) (Located (Trail V2 n))
-> (Located (Trail V2 n) -> Query V2 n Crossings)
-> Path V2 n
-> Query V2 n Crossings
forall r s a. Getting r s a -> (a -> r) -> s -> r
foldMapOf Getting (Query V2 n Crossings) (Path V2 n) (Located (Trail V2 n))
forall s t a b. Each s t a b => Traversal s t a b
each Located (Trail V2 n) -> Query V2 n Crossings
forall t m. HasQuery t m => t -> Query (V t) (N t) m
getQuery

-- | Test whether the given point is inside the given path,
--   by testing whether the point's /winding number/ is nonzero. Note
--   that @False@ is /always/ returned for paths consisting of lines
--   (as opposed to loops), regardless of the winding number.
--
-- @
-- 'isInsideWinding' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Bool'
-- 'isInsideWinding' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Bool'
-- 'isInsideWinding' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Bool'
-- @
isInsideWinding :: HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideWinding :: t -> Point (V t) (N t) -> Bool
isInsideWinding t
t = (Crossings -> Crossings -> Bool
forall a. Eq a => a -> a -> Bool
/= Crossings
0) (Crossings -> Bool)
-> (Point (V t) (N t) -> Crossings) -> Point (V t) (N t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Point (V t) (N t) -> Crossings
forall t m. HasQuery t m => t -> Point (V t) (N t) -> m
sample t
t

-- | Test whether the given point is inside the given path,
--   by testing whether a ray extending from the point in the positive
--   x direction crosses the path an even (outside) or odd (inside)
--   number of times.  Note that @False@ is /always/ returned for
--   paths consisting of lines (as opposed to loops), regardless of
--   the number of crossings.
--
-- @
-- 'isInsideEvenOdd' :: 'Path' 'V2' 'Double'                  -> 'Point' 'V2' 'Double' -> 'Bool'
-- 'isInsideEvenOdd' :: 'Located' ('Trail' 'V2' 'Double')       -> 'Point' 'V2' 'Double' -> 'Bool'
-- 'isInsideEvenOdd' :: 'Located' ('Trail'' 'Loop' 'V2' 'Double') -> 'Point' 'V2' 'Double' -> 'Bool'
-- @
isInsideEvenOdd :: HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideEvenOdd :: t -> Point (V t) (N t) -> Bool
isInsideEvenOdd t
t = Crossings -> Bool
forall a. Integral a => a -> Bool
odd (Crossings -> Bool)
-> (Point (V t) (N t) -> Crossings) -> Point (V t) (N t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Point (V t) (N t) -> Crossings
forall t m. HasQuery t m => t -> Point (V t) (N t) -> m
sample t
t

-- | Compute the sum of signed crossings of a trail starting from the
--   given point in the positive x direction.
trailCrossings :: RealFloat n => Point V2 n -> Located (Trail V2 n) -> Crossings

  -- non-loop trails have no inside or outside, so don't contribute crossings
trailCrossings :: Point V2 n -> Located (Trail V2 n) -> Crossings
trailCrossings Point V2 n
_ Located (Trail V2 n)
t | Bool -> Bool
not (Trail V2 n -> Bool
forall (v :: * -> *) n. Trail v n -> Bool
isLoop (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
t)) = Crossings
0

trailCrossings p :: Point V2 n
p@(Point V2 n -> (n, n)
forall n. P2 n -> (n, n)
unp2 -> (n
x,n
y)) Located (Trail V2 n)
tr
  = (FixedSegment V2 n -> Crossings)
-> [FixedSegment V2 n] -> Crossings
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap FixedSegment V2 n -> Crossings
test ([FixedSegment V2 n] -> Crossings)
-> [FixedSegment V2 n] -> Crossings
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail Located (Trail V2 n)
tr
  where
    test :: FixedSegment V2 n -> Crossings
test (FLinear a :: Point V2 n
a@(Point V2 n -> (n, n)
forall n. P2 n -> (n, n)
unp2 -> (n
_,n
ay)) b :: Point V2 n
b@(Point V2 n -> (n, n)
forall n. P2 n -> (n, n)
unp2 -> (n
_,n
by)))
      | n
ay n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
y Bool -> Bool -> Bool
&& n
by n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
y Bool -> Bool -> Bool
&& Point V2 n -> Point V2 n -> n
isLeft Point V2 n
a Point V2 n
b n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 =  Crossings
1
      | n
by n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
y Bool -> Bool -> Bool
&& n
ay n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
y Bool -> Bool -> Bool
&& Point V2 n -> Point V2 n -> n
isLeft Point V2 n
a Point V2 n
b n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 = -Crossings
1
      | Bool
otherwise                           =  Crossings
0

    test c :: FixedSegment V2 n
c@(FCubic (P x1 :: V2 n
x1@(V2 n
_ n
x1y))
                   (P c1 :: V2 n
c1@(V2 n
_ n
c1y))
                   (P c2 :: V2 n
c2@(V2 n
_ n
c2y))
                   (P x2 :: V2 n
x2@(V2 n
_ n
x2y))
           ) =
        [Crossings] -> Crossings
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Crossings] -> Crossings)
-> ([n] -> [Crossings]) -> [n] -> Crossings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Crossings) -> [n] -> [Crossings]
forall a b. (a -> b) -> [a] -> [b]
map n -> Crossings
testT ([n] -> Crossings) -> [n] -> Crossings
forall a b. (a -> b) -> a -> b
$ [n]
ts
      where ts :: [n]
ts = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool) -> (n -> Bool) -> (n -> Bool) -> n -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>=n
0) (n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<=n
1))
               ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ n -> n -> n -> n -> [n]
forall d. (Floating d, Ord d) => d -> d -> d -> d -> [d]
cubForm (-  n
x1y n -> n -> n
forall a. Num a => a -> a -> a
+ n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
c1y n -> n -> n
forall a. Num a => a -> a -> a
- n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
c2y n -> n -> n
forall a. Num a => a -> a -> a
+ n
x2y)
                         ( n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
x1y n -> n -> n
forall a. Num a => a -> a -> a
- n
6n -> n -> n
forall a. Num a => a -> a -> a
*n
c1y n -> n -> n
forall a. Num a => a -> a -> a
+ n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
c2y)
                         (-n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
x1y n -> n -> n
forall a. Num a => a -> a -> a
+ n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
c1y)
                         (n
x1y n -> n -> n
forall a. Num a => a -> a -> a
- n
y)
            testT :: n -> Crossings
testT n
t = let (Point V2 n -> (n, n)
forall n. P2 n -> (n, n)
unp2 -> (n
px,n
_)) = FixedSegment V2 n
c FixedSegment V2 n
-> N (FixedSegment V2 n)
-> Codomain (FixedSegment V2 n) (N (FixedSegment V2 n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (FixedSegment V2 n)
t
                      in  if n
px n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
x then n -> Crossings
signFromDerivAt n
t else Crossings
0
            signFromDerivAt :: n -> Crossings
signFromDerivAt n
t =
              let v :: V2 n
v =  (n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
tn -> n -> n
forall a. Num a => a -> a -> a
*n
t) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ ((-n
1)n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
x1 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ n
3n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c1 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ n
3n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c2 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 n
x2)
                   V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (n
2n -> n -> n
forall a. Num a => a -> a -> a
*n
t)   n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ (n
3n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
x1 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ n
6n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c1 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ n
3n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c2)
                   V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^            ((-n
3)n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
x1 V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ n
3n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 n
c1)
                  ang :: n
ang = V2 n
v V2 n -> Getting n (V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. (Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta ((Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n))
-> ((n -> Const n n) -> Angle n -> Const n (Angle n))
-> Getting n (V2 n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const n n) -> Angle n -> Const n (Angle n)
forall n. Iso' (Angle n) n
rad
              in  case () of ()
_ | n
0      n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
ang Bool -> Bool -> Bool
&& n
ang n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
forall a. Floating a => a
taun -> n -> n
forall a. Fractional a => a -> a -> a
/n
2 Bool -> Bool -> Bool
&& n
t n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
1 ->  Crossings
1
                               | -n
forall a. Floating a => a
taun -> n -> n
forall a. Fractional a => a -> a -> a
/n
2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
ang Bool -> Bool -> Bool
&& n
ang n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0     Bool -> Bool -> Bool
&& n
t n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
0 -> -Crossings
1
                               | Bool
otherwise                            ->  Crossings
0

    isLeft :: Point V2 n -> Point V2 n -> n
isLeft Point V2 n
a Point V2 n
b = V2 n -> V2 n -> n
forall n. Num n => V2 n -> V2 n -> n
cross2 (Point V2 n
b Point V2 n -> Point V2 n -> Diff (Point V2) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
a) (Point V2 n
p Point V2 n -> Point V2 n -> Diff (Point V2) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
a)

------------------------------------------------------------
--  Clipping  ----------------------------------------------
------------------------------------------------------------

-- | @Clip@ tracks the accumulated clipping paths applied to a
--   diagram.  Note that the semigroup structure on @Clip@ is list
--   concatenation, so applying multiple clipping paths is sensible.
--   The clipping region is the intersection of all the applied
--   clipping paths.
newtype Clip n = Clip [Path V2 n]
  deriving (Typeable, b -> Clip n -> Clip n
NonEmpty (Clip n) -> Clip n
Clip n -> Clip n -> Clip n
(Clip n -> Clip n -> Clip n)
-> (NonEmpty (Clip n) -> Clip n)
-> (forall b. Integral b => b -> Clip n -> Clip n)
-> Semigroup (Clip n)
forall b. Integral b => b -> Clip n -> Clip n
forall n. NonEmpty (Clip n) -> Clip n
forall n. Clip n -> Clip n -> Clip n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> Clip n -> Clip n
stimes :: b -> Clip n -> Clip n
$cstimes :: forall n b. Integral b => b -> Clip n -> Clip n
sconcat :: NonEmpty (Clip n) -> Clip n
$csconcat :: forall n. NonEmpty (Clip n) -> Clip n
<> :: Clip n -> Clip n -> Clip n
$c<> :: forall n. Clip n -> Clip n -> Clip n
Semigroup)

makeWrapped ''Clip

instance Typeable n => AttributeClass (Clip n)

instance AsEmpty (Clip n) where
  _Empty :: p () (f ()) -> p (Clip n) (f (Clip n))
_Empty = p [Path V2 n] (f [Path V2 n]) -> p (Clip n) (f (Clip n))
forall n n'. Iso (Clip n) (Clip n') [Path V2 n] [Path V2 n']
_Clip (p [Path V2 n] (f [Path V2 n]) -> p (Clip n) (f (Clip n)))
-> (p () (f ()) -> p [Path V2 n] (f [Path V2 n]))
-> p () (f ())
-> p (Clip n) (f (Clip n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p () (f ()) -> p [Path V2 n] (f [Path V2 n])
forall a. AsEmpty a => Prism' a ()
_Empty

type instance V (Clip n) = V2
type instance N (Clip n) = n

instance (OrderedField n) => Transformable (Clip n) where
  transform :: Transformation (V (Clip n)) (N (Clip n)) -> Clip n -> Clip n
transform Transformation (V (Clip n)) (N (Clip n))
t (Clip [Path V2 n]
ps) = [Path V2 n] -> Clip n
forall n. [Path V2 n] -> Clip n
Clip (Transformation (V [Path V2 n]) (N [Path V2 n])
-> [Path V2 n] -> [Path V2 n]
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V [Path V2 n]) (N [Path V2 n])
Transformation (V (Clip n)) (N (Clip n))
t [Path V2 n]
ps)

-- | A point inside a clip if the point is in 'All' invididual clipping
--   paths.
instance RealFloat n => HasQuery (Clip n) All where
  getQuery :: Clip n -> Query (V (Clip n)) (N (Clip n)) All
getQuery (Clip [Path V2 n]
paths) = (Point V2 n -> All) -> Query V2 n All
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point V2 n -> All) -> Query V2 n All)
-> (Point V2 n -> All) -> Query V2 n All
forall a b. (a -> b) -> a -> b
$ \Point V2 n
p ->
    (Path V2 n -> All) -> [Path V2 n] -> All
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Bool -> All
All (Bool -> All) -> (Path V2 n -> Bool) -> Path V2 n -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path V2 n -> Point V2 n -> Bool)
-> Point V2 n -> Path V2 n -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Path V2 n -> Point V2 n -> Bool
forall t. HasQuery t Crossings => t -> Point (V t) (N t) -> Bool
isInsideWinding Point V2 n
p) [Path V2 n]
paths

_Clip :: Iso (Clip n) (Clip n') [Path V2 n] [Path V2 n']
_Clip :: p [Path V2 n] (f [Path V2 n']) -> p (Clip n) (f (Clip n'))
_Clip = p [Path V2 n] (f [Path V2 n']) -> p (Clip n) (f (Clip n'))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped

-- | Lens onto the Clip in a style. An empty list means no clipping.
_clip :: (Typeable n, OrderedField n) => Lens' (Style V2 n) [Path V2 n]
_clip :: Lens' (Style V2 n) [Path V2 n]
_clip = (Maybe (Clip n) -> f (Maybe (Clip n)))
-> Style V2 n -> f (Style V2 n)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, AttributeClass a, Transformable a) =>
Lens' (Style v n) (Maybe a)
atTAttr ((Maybe (Clip n) -> f (Maybe (Clip n)))
 -> Style V2 n -> f (Style V2 n))
-> (([Path V2 n] -> f [Path V2 n])
    -> Maybe (Clip n) -> f (Maybe (Clip n)))
-> ([Path V2 n] -> f [Path V2 n])
-> Style V2 n
-> f (Style V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APrism' (Clip n) () -> Iso' (Maybe (Clip n)) (Clip n)
forall a. APrism' a () -> Iso' (Maybe a) a
non' APrism' (Clip n) ()
forall a. AsEmpty a => Prism' a ()
_Empty ((Clip n -> f (Clip n)) -> Maybe (Clip n) -> f (Maybe (Clip n)))
-> (([Path V2 n] -> f [Path V2 n]) -> Clip n -> f (Clip n))
-> ([Path V2 n] -> f [Path V2 n])
-> Maybe (Clip n)
-> f (Maybe (Clip n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Path V2 n] -> f [Path V2 n]) -> Clip n -> f (Clip n)
forall n n'. Iso (Clip n) (Clip n') [Path V2 n] [Path V2 n']
_Clip

-- | Clip a diagram by the given path:
--
--   * Only the parts of the diagram which lie in the interior of the
--     path will be drawn.
--
--   * The envelope of the diagram is unaffected.
clipBy :: (HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) => Path V2 n -> a -> a
clipBy :: Path V2 n -> a -> a
clipBy = Clip n -> a -> a
forall a d.
(AttributeClass a, Transformable a, V a ~ V d, N a ~ N d,
 HasStyle d) =>
a -> d -> d
applyTAttr (Clip n -> a -> a) -> (Path V2 n -> Clip n) -> Path V2 n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path V2 n] -> Clip n
forall n. [Path V2 n] -> Clip n
Clip ([Path V2 n] -> Clip n)
-> (Path V2 n -> [Path V2 n]) -> Path V2 n -> Clip n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path V2 n -> [Path V2 n] -> [Path V2 n]
forall a. a -> [a] -> [a]
:[])

-- | Clip a diagram to the given path setting its envelope to the
--   pointwise minimum of the envelopes of the diagram and path. The
--   trace consists of those parts of the original diagram's trace
--   which fall within the clipping path, or parts of the path's trace
--   within the original diagram.
clipTo :: TypeableFloat n
  => Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
clipTo :: Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
clipTo Path V2 n
p QDiagram b V2 n Any
d = Trace V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Semigroup m) =>
Trace v n -> QDiagram b v n m -> QDiagram b v n m
setTrace Trace V2 n
intersectionTrace (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 n Any -> QDiagram b V2 n Any
toEnvelope (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
clipBy Path V2 n
p QDiagram b V2 n Any
d
  where
    envP :: Maybe (V2 n -> n)
envP = Envelope V2 n -> Maybe (V2 n -> n)
forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope (Envelope V2 n -> Maybe (V2 n -> n))
-> (Path V2 n -> Envelope V2 n) -> Path V2 n -> Maybe (V2 n -> n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path V2 n -> Envelope V2 n
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope (Path V2 n -> Maybe (V2 n -> n)) -> Path V2 n -> Maybe (V2 n -> n)
forall a b. (a -> b) -> a -> b
$ Path V2 n
p
    envD :: Maybe (V2 n -> n)
envD = Envelope V2 n -> Maybe (V2 n -> n)
forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope (Envelope V2 n -> Maybe (V2 n -> n))
-> (QDiagram b V2 n Any -> Envelope V2 n)
-> QDiagram b V2 n Any
-> Maybe (V2 n -> n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 n Any -> Envelope V2 n
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope (QDiagram b V2 n Any -> Maybe (V2 n -> n))
-> QDiagram b V2 n Any -> Maybe (V2 n -> n)
forall a b. (a -> b) -> a -> b
$ QDiagram b V2 n Any
d
    toEnvelope :: QDiagram b V2 n Any -> QDiagram b V2 n Any
toEnvelope = case (Maybe (V2 n -> n)
envP, Maybe (V2 n -> n)
envD) of
      (Just V2 n -> n
eP, Just V2 n -> n
eD) -> Envelope V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall b (v :: * -> *) n m.
(OrderedField n, Metric v, Monoid' m) =>
Envelope v n -> QDiagram b v n m -> QDiagram b v n m
setEnvelope (Envelope V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> ((V2 n -> n) -> Envelope V2 n)
-> (V2 n -> n)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 n -> n) -> Envelope V2 n
forall (v :: * -> *) n. (v n -> n) -> Envelope v n
mkEnvelope ((V2 n -> n) -> QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (V2 n -> n) -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ \V2 n
v -> n -> n -> n
forall a. Ord a => a -> a -> a
min (V2 n -> n
eP V2 n
v) (V2 n -> n
eD V2 n
v)
      (Maybe (V2 n -> n)
_, Maybe (V2 n -> n)
_)             -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. a -> a
id
    intersectionTrace :: Trace V2 n
intersectionTrace = (Point V2 n -> V2 n -> SortedList n) -> Trace V2 n
forall (v :: * -> *) n.
(Point v n -> v n -> SortedList n) -> Trace v n
Trace Point V2 n -> V2 n -> SortedList n
traceIntersections
    traceIntersections :: Point V2 n -> V2 n -> SortedList n
traceIntersections Point V2 n
pt V2 n
v =
        -- on boundary of d, inside p
        ([n] -> [n]) -> SortedList n -> SortedList n
forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
onSortedList ((n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter n -> Bool
pInside) (Trace V2 n -> Point V2 n -> V2 n -> SortedList n
forall (v :: * -> *) n.
Trace v n -> Point v n -> v n -> SortedList n
appTrace (QDiagram b V2 n Any
-> Trace (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace QDiagram b V2 n Any
d) Point V2 n
pt V2 n
v) SortedList n -> SortedList n -> SortedList n
forall a. Semigroup a => a -> a -> a
<>
        -- or on boundary of p, inside d
        ([n] -> [n]) -> SortedList n -> SortedList n
forall b a. Ord b => ([a] -> [b]) -> SortedList a -> SortedList b
onSortedList ((n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter n -> Bool
dInside) (Trace V2 n -> Point V2 n -> V2 n -> SortedList n
forall (v :: * -> *) n.
Trace v n -> Point v n -> v n -> SortedList n
appTrace (Path V2 n -> Trace (V (Path V2 n)) (N (Path V2 n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace Path V2 n
p) Point V2 n
pt V2 n
v) where
          newPt :: n -> Point V2 n
newPt n
dist = Point V2 n
pt Point V2 n -> Diff (Point V2) n -> Point V2 n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 n
v V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
dist
          pInside :: n -> Bool
pInside n
dDist = FillRule -> Path V2 n -> Point V2 n -> Bool
forall n.
RealFloat n =>
FillRule -> Path V2 n -> Point V2 n -> Bool
runFillRule FillRule
Winding Path V2 n
p (n -> Point V2 n
newPt n
dDist)
          dInside :: n -> Bool
dInside n
pDist = Any -> Bool
getAny (Any -> Bool) -> (Point V2 n -> Any) -> Point V2 n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QDiagram b V2 n Any
-> Point (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any)) -> Any
forall t m. HasQuery t m => t -> Point (V t) (N t) -> m
sample QDiagram b V2 n Any
d (Point V2 n -> Bool) -> Point V2 n -> Bool
forall a b. (a -> b) -> a -> b
$ n -> Point V2 n
newPt n
pDist

-- | Clip a diagram to the clip path taking the envelope and trace of the clip
--   path.
clipped :: TypeableFloat n
  => Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
clipped :: Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
clipped Path V2 n
p = Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n a m b.
(InSpace v n a, Metric v, OrderedField n, Monoid' m, Traced a) =>
a -> QDiagram b v n m -> QDiagram b v n m
withTrace Path V2 n
p (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n a m b.
(InSpace v n a, Monoid' m, Enveloped a) =>
a -> QDiagram b v n m -> QDiagram b v n m
withEnvelope Path V2 n
p (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path V2 n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
clipBy Path V2 n
p

------------------------------------------------------------
--  Intersections  -----------------------------------------
------------------------------------------------------------

-- | Find the intersect points of two objects that can be converted to a path.
intersectPoints :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n)
  => t -> s -> [P2 n]
intersectPoints :: t -> s -> [P2 n]
intersectPoints = n -> t -> s -> [P2 n]
forall n t s.
(InSpace V2 n t, SameSpace t s, ToPath t, ToPath s,
 OrderedField n) =>
n -> t -> s -> [P2 n]
intersectPoints' n
1e-8

-- | Find the intersect points of two objects that can be converted to a path
--   within the given tolerance.
intersectPoints' :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n)
  => n -> t -> s -> [P2 n]
intersectPoints' :: n -> t -> s -> [P2 n]
intersectPoints' n
eps t
t s
s = n -> Path V2 n -> Path V2 n -> [P2 n]
forall n. OrderedField n => n -> Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP' n
eps (t -> Path (V t) (N t)
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath t
t) (s -> Path (V s) (N s)
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath s
s)

-- | Compute the intersect points between two paths.
intersectPointsP :: OrderedField n => Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP :: Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP = n -> Path V2 n -> Path V2 n -> [P2 n]
forall n. OrderedField n => n -> Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP' n
1e-8

-- | Compute the intersect points between two paths within given tolerance.
intersectPointsP' :: OrderedField n => n -> Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP' :: n -> Path V2 n -> Path V2 n -> [P2 n]
intersectPointsP' n
eps Path V2 n
as Path V2 n
bs = do
  Located (Trail V2 n)
a <- Path V2 n -> [Located (Trail V2 n)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
as
  Located (Trail V2 n)
b <- Path V2 n -> [Located (Trail V2 n)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
bs
  n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT' n
eps Located (Trail V2 n)
a Located (Trail V2 n)
b

-- | Compute the intersect points between two located trails.
intersectPointsT :: OrderedField n => Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT :: Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT = n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT' n
1e-8

-- | Compute the intersect points between two located trails within the given
--   tolerance.
intersectPointsT' :: OrderedField n => n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT' :: n -> Located (Trail V2 n) -> Located (Trail V2 n) -> [P2 n]
intersectPointsT' n
eps Located (Trail V2 n)
as Located (Trail V2 n)
bs = do
  FixedSegment V2 n
a <- Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail Located (Trail V2 n)
as
  FixedSegment V2 n
b <- Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail Located (Trail V2 n)
bs
  n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
forall n.
OrderedField n =>
n -> FixedSegment V2 n -> FixedSegment V2 n -> [P2 n]
intersectPointsS' n
eps FixedSegment V2 n
a FixedSegment V2 n
b