{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
  -- for Data.Semigroup

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Combinators
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Diagram combinators specialized to two dimensions. For more general
-- combinators, see "Diagrams.Combinators".
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Combinators
    (
      -- * Binary combinators

      (===), (|||)

      -- * n-ary combinators
    , hcat, hcat', hsep
    , vcat, vcat', vsep

      -- * Spacing/envelopes
    , strutR2
    , strutX, strutY
    , padX, padY

    , extrudeLeft, extrudeRight, extrudeBottom, extrudeTop

    , rectEnvelope, crop

    , boundingRect, bg, bgFrame

    ) where

import           Control.Lens             ((&), (.~))
import           Data.Colour
import           Data.Default.Class
import           Data.Semigroup

import           Diagrams.Core

import           Diagrams.Attributes      (lwO)
import           Diagrams.BoundingBox
import           Diagrams.Combinators
import           Diagrams.Path
import           Diagrams.Query           (value)
import           Diagrams.Segment
import           Diagrams.TrailLike
import           Diagrams.TwoD.Align
import           Diagrams.TwoD.Attributes (fc)
import           Diagrams.TwoD.Path       ()
import           Diagrams.TwoD.Shapes
import           Diagrams.TwoD.Transform  (scaleX, scaleY)
import           Diagrams.TwoD.Types
import           Diagrams.TwoD.Vector
import           Diagrams.Util            (( # ))

import           Linear.Affine
import           Linear.Metric
import           Linear.Vector

infixl 6 ===
infixl 6 |||

-- | Place two diagrams (or other objects) vertically adjacent to one
--   another, with the first diagram above the second.  Since Haskell
--   ignores whitespace in expressions, one can thus write
--
--   @
--       c
--      ===
--       d
--   @
--
--   to place @c@ above @d@.  The local origin of the resulting
--   combined diagram is the same as the local origin of the first.
--   @(===)@ is associative and has 'mempty' as an identity.  See the
--   documentation of 'beside' for more information.
(===) :: (InSpace V2 n a, Juxtaposable a, Semigroup a) => a -> a -> a
=== :: forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
(===) = Vn a -> a -> a -> a
forall a. (Juxtaposable a, Semigroup a) => Vn a -> a -> a -> a
beside Vn a
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y

-- | Place two diagrams (or other juxtaposable objects) horizontally
--   adjacent to one another, with the first diagram to the left of
--   the second.  The local origin of the resulting combined diagram
--   is the same as the local origin of the first.  @(|||)@ is
--   associative and has 'mempty' as an identity.  See the
--   documentation of 'beside' for more information.
(|||) :: (InSpace V2 n a, Juxtaposable a, Semigroup a) => a -> a -> a
||| :: forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
(|||) = Vn a -> a -> a -> a
forall a. (Juxtaposable a, Semigroup a) => Vn a -> a -> a -> a
beside Vn a
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX

-- | Lay out a list of juxtaposable objects in a row from left to right,
--   so that their local origins lie along a single horizontal line,
--   with successive envelopes tangent to one another.
--
--   * For more control over the spacing, see 'hcat''.
--
--   * To align the diagrams vertically (or otherwise), use alignment
--     combinators (such as 'alignT' or 'alignB') from
--     "Diagrams.TwoD.Align" before applying 'hcat'.
--
--   * For non-axis-aligned layout, see 'cat'.
hcat :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
     => [a] -> a
hcat :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
hcat = CatOpts n -> [a] -> a
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' CatOpts n
forall a. Default a => a
def

-- | A variant of 'hcat' taking an extra 'CatOpts' record to control
--   the spacing.  See the 'cat'' documentation for a description of
--   the possibilities. For the common case of setting just a
--   separation amount, see 'hsep'.
hcat' :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
      => CatOpts n -> [a] -> a
hcat' :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' = V2 n -> CatOpts n -> [a] -> a
forall (v :: * -> *) n a.
(InSpace v n a, Metric v, Floating n, Juxtaposable a, Monoid' a,
 HasOrigin a) =>
v n -> CatOpts n -> [a] -> a
cat' V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX

-- | A convenient synonym for horizontal concatenation with
--   separation: @hsep s === hcat' (with & sep .~ s)@.
hsep :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
     => n -> [a] -> a
hsep :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
hsep n
s = CatOpts n -> [a] -> a
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' (CatOpts n
forall a. Default a => a
def CatOpts n -> (CatOpts n -> CatOpts n) -> CatOpts n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> CatOpts n -> Identity (CatOpts n)
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> CatOpts n -> f (CatOpts n)
sep ((n -> Identity n) -> CatOpts n -> Identity (CatOpts n))
-> n -> CatOpts n -> CatOpts n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
s)

-- | Lay out a list of juxtaposable objects in a column from top to
--   bottom, so that their local origins lie along a single vertical
--   line, with successive envelopes tangent to one another.
--
--   * For more control over the spacing, see 'vcat''.
--
--   * To align the diagrams horizontally (or otherwise), use alignment
--     combinators (such as 'alignL' or 'alignR') from
--     "Diagrams.TwoD.Align" before applying 'vcat'.
--
--   * For non-axis-aligned layout, see 'cat'.
vcat :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
     => [a] -> a
vcat :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
vcat = CatOpts n -> [a] -> a
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
vcat' CatOpts n
forall a. Default a => a
def

-- | A variant of 'vcat' taking an extra 'CatOpts' record to control
--   the spacing.  See the 'cat'' documentation for a description of
--   the possibilities.  For the common case of setting just a
--   separation amount, see 'vsep'.
vcat' :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
      => CatOpts n -> [a] -> a
vcat' :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
vcat' = V2 n -> CatOpts n -> [a] -> a
forall (v :: * -> *) n a.
(InSpace v n a, Metric v, Floating n, Juxtaposable a, Monoid' a,
 HasOrigin a) =>
v n -> CatOpts n -> [a] -> a
cat' V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y

-- | A convenient synonym for vertical concatenation with
--   separation: @vsep s === vcat' (with & sep .~ s)@.
vsep :: (InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a, Monoid' a)
     => n -> [a] -> a
vsep :: forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
n -> [a] -> a
vsep n
s = CatOpts n -> [a] -> a
forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
vcat' (CatOpts n
forall a. Default a => a
def CatOpts n -> (CatOpts n -> CatOpts n) -> CatOpts n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> CatOpts n -> Identity (CatOpts n)
forall n (f :: * -> *).
Functor f =>
(n -> f n) -> CatOpts n -> f (CatOpts n)
sep ((n -> Identity n) -> CatOpts n -> Identity (CatOpts n))
-> n -> CatOpts n -> CatOpts n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
s)

-- | @strutR2 v@ is a two-dimensional diagram which produces no
--   output, but with respect to alignment, envelope, /and trace/ acts
--   like a 1-dimensional segment oriented along the vector @v@, with
--   local origin at its center.  If you don't care about the trace
--   then there's no difference between @strutR2@ and the more general
--   'strut'.
strutR2 :: (RealFloat n, Monoid' m) => V2 n -> QDiagram b V2 n m
strutR2 :: forall n m b. (RealFloat n, Monoid' m) => V2 n -> QDiagram b V2 n m
strutR2 V2 n
v = FixedSegment V2 n -> QDiagram b V2 n m
forall (v :: * -> *) n a m b.
(InSpace v n a, Monoid' m, Enveloped a, Traced a) =>
a -> QDiagram b v n m
phantom FixedSegment V2 n
seg
  where
    seg :: FixedSegment V2 n
seg = Point V2 n -> Point V2 n -> FixedSegment V2 n
forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear (Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ n
0.5 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
v) (Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (-n
0.5) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
v)

-- | @strutX w@ is an empty diagram with width @w@, height 0, and a
--   centered local origin.  Note that @strutX (-w)@ behaves the same as
--   @strutX w@.
strutX :: (Metric v, R1 v, OrderedField n) => n -> QDiagram b v n m
strutX :: forall (v :: * -> *) n b m.
(Metric v, R1 v, OrderedField n) =>
n -> QDiagram b v n m
strutX n
d = v n -> QDiagram b v n m
forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
v n -> QDiagram b v n m
strut (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n -> (v n -> v n) -> v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
d)

-- | @strutY h@ is an empty diagram with height @h@, width 0, and a
--   centered local origin. Note that @strutY (-h)@ behaves the same as
--   @strutY h@.
strutY :: (Metric v, R2 v, OrderedField n) => n -> QDiagram b v n m
strutY :: forall (v :: * -> *) n b m.
(Metric v, R2 v, OrderedField n) =>
n -> QDiagram b v n m
strutY n
d = v n -> QDiagram b v n m
forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
v n -> QDiagram b v n m
strut (v n
forall a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero v n -> (v n -> v n) -> v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> v n -> Identity (v n)
forall a. Lens' (v a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> v n -> Identity (v n)) -> n -> v n -> v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
d)

-- | @padX s@ \"pads\" a diagram in the x-direction, expanding its
--   envelope horizontally by a factor of @s@ (factors between 0 and 1
--   can be used to shrink the envelope).  Note that the envelope will
--   expand with respect to the local origin, so if the origin is not
--   centered horizontally the padding may appear \"uneven\".  If this
--   is not desired, the origin can be centered (using 'centerX')
--   before applying @padX@.
padX :: (Metric v, R2 v, OrderedField n, Monoid' m)
     => n -> QDiagram b v n m -> QDiagram b v n m
padX :: forall (v :: * -> *) n m b.
(Metric v, R2 v, OrderedField n, Monoid' m) =>
n -> QDiagram b v n m -> QDiagram b v n m
padX n
s QDiagram b v n m
d = QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
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 (QDiagram b v n m
d QDiagram b v n m
-> (QDiagram b v n m -> QDiagram b v n m) -> QDiagram b v n m
forall a b. a -> (a -> b) -> b
# n -> QDiagram b v n m -> QDiagram b v n m
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
s) QDiagram b v n m
d

-- | @padY s@ \"pads\" a diagram in the y-direction, expanding its
--   envelope vertically by a factor of @s@ (factors between
--   0 and 1 can be used to shrink the envelope).  Note that
--   the envelope will expand with respect to the local origin,
--   so if the origin is not centered vertically the padding may appear
--   \"uneven\".  If this is not desired, the origin can be centered
--   (using 'centerY') before applying @padY@.
padY :: (Metric v, R2 v, Monoid' m, OrderedField n)
     => n -> QDiagram b v n m -> QDiagram b v n m
padY :: forall (v :: * -> *) m n b.
(Metric v, R2 v, Monoid' m, OrderedField n) =>
n -> QDiagram b v n m -> QDiagram b v n m
padY n
s QDiagram b v n m
d = QDiagram b v n m -> QDiagram b v n m -> QDiagram b v n m
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 (QDiagram b v n m
d QDiagram b v n m
-> (QDiagram b v n m -> QDiagram b v n m) -> QDiagram b v n m
forall a b. a -> (a -> b) -> b
# n -> QDiagram b v n m -> QDiagram b v n m
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
s) QDiagram b v n m
d

-- | @extrudeLeft s@ \"extrudes\" a diagram in the negative x-direction,
--   offsetting its envelope by the provided distance. When @ s < 0 @,
--   the envelope is inset instead.
--
--   See the documentation for 'extrudeEnvelope' for more information.
extrudeLeft :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeLeft :: forall n m b.
(OrderedField n, Monoid' m) =>
n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeLeft n
s
  | n
s n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0    = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n -> n
forall a. Num a => a -> a
negate n
s
  | Bool
otherwise = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n -> n
forall a. Num a => a -> a
negate n
s

-- | @extrudeRight s@ \"extrudes\" a diagram in the positive x-direction,
--   offsetting its envelope by the provided distance. When @ s < 0 @,
--   the envelope is inset instead.
--
--   See the documentation for 'extrudeEnvelope' for more information.
extrudeRight :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeRight :: forall n m b.
(OrderedField n, Monoid' m) =>
n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeRight n
s
  | n
s n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0    = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
  | Bool
otherwise = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s

-- | @extrudeBottom s@ \"extrudes\" a diagram in the negative y-direction,
--   offsetting its envelope by the provided distance. When @ s < 0 @,
--   the envelope is inset instead.
--
--   See the documentation for 'extrudeEnvelope' for more information.
extrudeBottom :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeBottom :: forall n m b.
(OrderedField n, Monoid' m) =>
n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeBottom n
s
  | n
s n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0    = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n -> n
forall a. Num a => a -> a
negate n
s
  | Bool
otherwise = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n -> n
forall a. Num a => a -> a
negate n
s

-- | @extrudeTop s@ \"extrudes\" a diagram in the positive y-direction,
--   offsetting its envelope by the provided distance. When @ s < 0 @,
--   the envelope is inset instead.
--
--   See the documentation for 'extrudeEnvelope' for more information.
extrudeTop :: (OrderedField n, Monoid' m) => n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeTop :: forall n m b.
(OrderedField n, Monoid' m) =>
n -> QDiagram b V2 n m -> QDiagram b V2 n m
extrudeTop n
s
  | n
s n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0    = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
  | Bool
otherwise = V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope (V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m)
-> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s

-- | @rectEnvelope p v@ sets the envelope of a diagram to a rectangle whose
--   lower-left corner is at @p@ and whose upper-right corner is at @p
--   .+^ v@.  Useful for selecting the rectangular portion of a
--   diagram which should actually be \"viewed\" in the final render,
--   if you don't want to see the entire diagram.
rectEnvelope :: forall b n m. (OrderedField n, Monoid' m)
     => Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope :: forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope Point V2 n
p (V2 n
w n
h) = Path V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
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 (n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
w n
h Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Point V2 n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point V2 n
p :: Path V2 n)

-- | A synonym for 'rectEnvelope'.
crop :: forall b n m. (OrderedField n, Monoid' m)
     => Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
crop :: forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
crop = Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope

-- | Construct a bounding rectangle for an enveloped object, that is,
--   the smallest axis-aligned rectangle which encloses the object.
boundingRect :: ( InSpace V2 n a, SameSpace a t
                , Enveloped t, Transformable t, TrailLike t, Monoid t
                , Enveloped a)
             => a -> t
boundingRect :: forall n a t.
(InSpace V2 n a, SameSpace a t, Enveloped t, Transformable t,
 TrailLike t, Monoid t, Enveloped a) =>
a -> t
boundingRect = (BoundingBox V2 n -> t -> t
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a, Transformable a,
 Monoid a) =>
BoundingBox v n -> a -> a
`boxFit` n -> n -> t
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
1 n
1) (BoundingBox V2 n -> t) -> (a -> BoundingBox V2 n) -> a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BoundingBox V2 n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox

-- | \"Set the background color\" of a diagram.  That is, place a
--   diagram atop a bounding rectangle of the given color.
--   The background does not change the result of queries.
bg :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' q)
    => Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q
bg :: forall n b q.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' q) =>
Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q
bg Colour Double
c QDiagram b V2 n q
d = QDiagram b V2 n q
d QDiagram b V2 n q -> QDiagram b V2 n q -> QDiagram b V2 n q
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n q -> QDiagram b V2 n Any
forall n a t.
(InSpace V2 n a, SameSpace a t, Enveloped t, Transformable t,
 TrailLike t, Monoid t, Enveloped a) =>
a -> t
boundingRect QDiagram b V2 n q
d QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n. (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO n
0 QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n q) -> QDiagram b V2 n q
forall a b. a -> (a -> b) -> b
# q -> QDiagram b V2 n Any -> QDiagram b V2 n q
forall m b (v :: * -> *) n.
Monoid m =>
m -> QDiagram b v n Any -> QDiagram b v n m
value q
forall a. Monoid a => a
mempty

-- | Similar to 'bg' but makes the colored background rectangle larger than
--   the diagram. The first parameter is used to set how far the background
--   extends beyond the diagram.
--   The background does not change the result of queries.
bgFrame :: (TypeableFloat n, Renderable (Path V2 n) b, Monoid' q)
    => n -> Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q
bgFrame :: forall n b q.
(TypeableFloat n, Renderable (Path V2 n) b, Monoid' q) =>
n -> Colour Double -> QDiagram b V2 n q -> QDiagram b V2 n q
bgFrame n
f Colour Double
c QDiagram b V2 n q
d = QDiagram b V2 n q
d QDiagram b V2 n q -> QDiagram b V2 n q -> QDiagram b V2 n q
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n q -> QDiagram b V2 n Any
forall n a t.
(InSpace V2 n a, SameSpace a t, Enveloped t, Transformable t,
 TrailLike t, Monoid t, Enveloped a) =>
a -> t
boundingRect (n -> QDiagram b V2 n q -> QDiagram b V2 n q
forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
n -> QDiagram b v n m -> QDiagram b v n m
frame n
f QDiagram b V2 n q
d) QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n. (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO n
0 QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n q) -> QDiagram b V2 n q
forall a b. a -> (a -> b) -> b
# q -> QDiagram b V2 n Any -> QDiagram b V2 n q
forall m b (v :: * -> *) n.
Monoid m =>
m -> QDiagram b v n Any -> QDiagram b v n m
value q
forall a. Monoid a => a
mempty