{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Diagrams.TwoD.Combinators
(
(===), (|||)
, hcat, hcat', hsep
, vcat, vcat', vsep
, 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 |||
(===) :: (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
(===) = forall a. (Juxtaposable a, Semigroup a) => Vn a -> a -> a -> a
beside forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y
(|||) :: (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
(|||) = forall a. (Juxtaposable a, Semigroup a) => Vn a -> a -> a -> a
beside forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
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 = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
Monoid' a) =>
CatOpts n -> [a] -> a
hcat' forall a. Default a => a
def
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' = 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' forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
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 = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
Monoid' a) =>
CatOpts n -> [a] -> a
hcat' (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sep forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
s)
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 = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
Monoid' a) =>
CatOpts n -> [a] -> a
vcat' forall a. Default a => a
def
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' = 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' forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y
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 = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
Monoid' a) =>
CatOpts n -> [a] -> a
vcat' (forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sep forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
s)
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 = 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 = forall (v :: * -> *) n. Point v n -> Point v n -> FixedSegment v n
FLinear (forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ n
0.5 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
v) (forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (-n
0.5) forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
v)
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 = forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
v n -> QDiagram b v n m
strut (forall (f :: * -> *) a. (Additive f, Num a) => f a
zero forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
d)
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 = forall (v :: * -> *) n b m.
(Metric v, OrderedField n) =>
v n -> QDiagram b v n m
strut (forall (f :: * -> *) a. (Additive f, Num a) => f a
zero forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
d)
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 = 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 forall a b. a -> (a -> b) -> b
# 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 :: (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 = 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 forall a b. a -> (a -> b) -> b
# 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 :: (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 forall a. Ord a => a -> a -> Bool
>= n
0 = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Num a => a -> a
negate n
s
| Bool
otherwise = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Num a => a -> a
negate n
s
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 forall a. Ord a => a -> a -> Bool
>= n
0 = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
| Bool
otherwise = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
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 forall a. Ord a => a -> a -> Bool
>= n
0 = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Num a => a -> a
negate n
s
| Bool
otherwise = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* forall a. Num a => a -> a
negate n
s
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 forall a. Ord a => a -> a -> Bool
>= n
0 = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
extrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
| Bool
otherwise = forall (v :: * -> *) n m b.
(Metric v, OrderedField n, Monoid' m) =>
v n -> QDiagram b v n m -> QDiagram b v n m
intrudeEnvelope forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* n
s
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) = 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 (forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
w n
h forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBL forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point V2 n
p :: Path V2 n)
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 = forall b n m.
(OrderedField n, Monoid' m) =>
Point V2 n -> V2 n -> QDiagram b V2 n m -> QDiagram b V2 n m
rectEnvelope
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 = (forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a, Transformable a,
Monoid a) =>
BoundingBox v n -> a -> a
`boxFit` forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
1 n
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox
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 forall a. Semigroup a => a -> a -> a
<> 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 forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO n
0 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c forall a b. a -> (a -> b) -> b
# forall m b (v :: * -> *) n.
Monoid m =>
m -> QDiagram b v n Any -> QDiagram b v n m
value forall a. Monoid a => a
mempty
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 forall a. Semigroup a => a -> a -> a
<> forall n a t.
(InSpace V2 n a, SameSpace a t, Enveloped t, Transformable t,
TrailLike t, Monoid t, Enveloped a) =>
a -> t
boundingRect (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) forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n) => n -> a -> a
lwO n
0 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c forall a b. a -> (a -> b) -> b
# forall m b (v :: * -> *) n.
Monoid m =>
m -> QDiagram b v n Any -> QDiagram b v n m
value forall a. Monoid a => a
mempty