{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-missing-role-annotations #-}

module Dashi.Diagram where

import Dashi.Prelude hiding (transform)
import Miso.Html.Property qualified as Html
import Miso.Html.Property qualified as Svg
import Miso.String qualified as MisoString
import Miso.Svg qualified
import Miso.Svg qualified as Svg
import Miso.Svg.Property qualified as Svg

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

class Shape s num | s -> num where
    boundingBox :: s -> Rect num
    transform :: (Point num -> Point num) -> s -> s

class (Shape s num) => ToSVG s num | s -> num where
    toSVG :: [Attribute action] -> s -> [View model action]

instance {-# OVERLAPS #-} (Num num, Ord num, Shape s num, Foldable f, Functor f) => Shape (f s) num where
    boundingBox :: f s -> Rect num
boundingBox = f (Rect num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Num num, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects (f (Rect num) -> Rect num)
-> (f s -> f (Rect num)) -> f s -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (s -> Rect num) -> f s -> f (Rect num)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox
    transform :: (Point num -> Point num) -> f s -> f s
transform = (s -> s) -> f s -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((s -> s) -> f s -> f s)
-> ((Point num -> Point num) -> s -> s)
-> (Point num -> Point num)
-> f s
-> f s
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Point num -> Point num) -> s -> s
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform

instance {-# OVERLAPS #-} (Num num, Ord num, ToSVG s num, Foldable f, Functor f) => ToSVG (f s) num where
    toSVG :: forall action model.
[Attribute action] -> f s -> [View model action]
toSVG = (s -> [View model action]) -> f s -> [View model action]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((s -> [View model action]) -> f s -> [View model action])
-> ([Attribute action] -> s -> [View model action])
-> [Attribute action]
-> f s
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> s -> [View model action]
forall action model. [Attribute action] -> s -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG

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

data Point num = Point {forall num. Point num -> num
x :: num, forall num. Point num -> num
y :: num}
    deriving stock ((forall x. Point num -> Rep (Point num) x)
-> (forall x. Rep (Point num) x -> Point num)
-> Generic (Point num)
forall x. Rep (Point num) x -> Point num
forall x. Point num -> Rep (Point num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Point num) x -> Point num
forall num x. Point num -> Rep (Point num) x
$cfrom :: forall num x. Point num -> Rep (Point num) x
from :: forall x. Point num -> Rep (Point num) x
$cto :: forall num x. Rep (Point num) x -> Point num
to :: forall x. Rep (Point num) x -> Point num
Generic, Point num -> Point num -> Bool
(Point num -> Point num -> Bool)
-> (Point num -> Point num -> Bool) -> Eq (Point num)
forall num. Eq num => Point num -> Point num -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall num. Eq num => Point num -> Point num -> Bool
== :: Point num -> Point num -> Bool
$c/= :: forall num. Eq num => Point num -> Point num -> Bool
/= :: Point num -> Point num -> Bool
Eq, Int -> Point num -> ShowS
[Point num] -> ShowS
Point num -> String
(Int -> Point num -> ShowS)
-> (Point num -> String)
-> ([Point num] -> ShowS)
-> Show (Point num)
forall num. Show num => Int -> Point num -> ShowS
forall num. Show num => [Point num] -> ShowS
forall num. Show num => Point num -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall num. Show num => Int -> Point num -> ShowS
showsPrec :: Int -> Point num -> ShowS
$cshow :: forall num. Show num => Point num -> String
show :: Point num -> String
$cshowList :: forall num. Show num => [Point num] -> ShowS
showList :: [Point num] -> ShowS
Show)

instance Shape (Point num) num where
    boundingBox :: Point num -> Rect num
boundingBox Point num
p = Point num -> Point num -> Rect num
forall num. Point num -> Point num -> Rect num
Rect Point num
p Point num
p
    transform :: (Point num -> Point num) -> Point num -> Point num
transform Point num -> Point num
f = Point num -> Point num
f

offsetPoint :: (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint :: forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint num -> num
fx num -> num
fy = (ASetter (Point num) (Point num) num num
#x ASetter (Point num) (Point num) num num
-> (num -> num) -> Point num -> Point num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ num -> num
fx) (Point num -> Point num)
-> (Point num -> Point num) -> Point num -> Point num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ASetter (Point num) (Point num) num num
#y ASetter (Point num) (Point num) num num
-> (num -> num) -> Point num -> Point num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ num -> num
fy)

boundingBoxOfPoints1
    :: forall f num. (Foldable f, Functor f, Ord num) => f (Point num) -> Rect num
boundingBoxOfPoints1 :: forall (f :: * -> *) num.
(Foldable f, Functor f, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints1 f (Point num)
points =
    Rect
        { topLeft :: Point num
topLeft =
            Point
                { x :: num
x = f num -> num
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum f num
xs
                , y :: num
y = f num -> num
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum f num
ys
                }
        , bottomRight :: Point num
bottomRight =
            Point
                { x :: num
x = f num -> num
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum f num
xs
                , y :: num
y = f num -> num
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum f num
ys
                }
        }
  where
    xs :: f num
xs = Point num -> num
forall num. Point num -> num
x (Point num -> num) -> f (Point num) -> f num
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Point num)
points
    ys :: f num
ys = Point num -> num
forall num. Point num -> num
y (Point num -> num) -> f (Point num) -> f num
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Point num)
points

boundingBoxOfPoints
    :: forall f num
     . (Foldable f, Functor f, Num num, Ord num) => f (Point num) -> Rect num
boundingBoxOfPoints :: forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints (f (Point num) -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -> Bool
True) = Point num -> Point num -> Rect num
forall num. Point num -> Point num -> Rect num
Rect (num -> num -> Point num
forall num. num -> num -> Point num
Point num
0 num
0) (num -> num -> Point num
forall num. num -> num -> Point num
Point num
0 num
0)
boundingBoxOfPoints f (Point num)
points = f (Point num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints1 f (Point num)
points

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

data Rect num = Rect {forall num. Rect num -> Point num
topLeft :: Point num, forall num. Rect num -> Point num
bottomRight :: Point num}
    deriving stock ((forall x. Rect num -> Rep (Rect num) x)
-> (forall x. Rep (Rect num) x -> Rect num) -> Generic (Rect num)
forall x. Rep (Rect num) x -> Rect num
forall x. Rect num -> Rep (Rect num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Rect num) x -> Rect num
forall num x. Rect num -> Rep (Rect num) x
$cfrom :: forall num x. Rect num -> Rep (Rect num) x
from :: forall x. Rect num -> Rep (Rect num) x
$cto :: forall num x. Rep (Rect num) x -> Rect num
to :: forall x. Rep (Rect num) x -> Rect num
Generic)

rectSize :: (Num num) => Rect num -> (num, num)
rectSize :: forall num. Num num => Rect num -> (num, num)
rectSize Rect{topLeft :: forall num. Rect num -> Point num
topLeft = Point{x :: forall num. Point num -> num
x = num
l, y :: forall num. Point num -> num
y = num
t}, bottomRight :: forall num. Rect num -> Point num
bottomRight = Point{x :: forall num. Point num -> num
x = num
r, y :: forall num. Point num -> num
y = num
b}} = (num
r num -> num -> num
forall a. Num a => a -> a -> a
- num
l, num
b num -> num -> num
forall a. Num a => a -> a -> a
- num
t)

top :: Lens' (Rect num) num
top :: forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
top = (Point num -> f (Point num)) -> Rect num -> f (Rect num)
#topLeft ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#y

left :: Lens' (Rect num) num
left :: forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
left = (Point num -> f (Point num)) -> Rect num -> f (Rect num)
#topLeft ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#x

topRight :: Lens' (Rect num) (Point num)
topRight :: forall num (f :: * -> *).
Functor f =>
(Point num -> f (Point num)) -> Rect num -> f (Rect num)
topRight =
    (Rect num -> Point num)
-> (Rect num -> Point num -> Rect num)
-> Lens (Rect num) (Rect num) (Point num) (Point num)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
        (\Rect{topLeft :: forall num. Rect num -> Point num
topLeft = Point{num
y :: forall num. Point num -> num
y :: num
y}, bottomRight :: forall num. Rect num -> Point num
bottomRight = Point{num
x :: forall num. Point num -> num
x :: num
x}} -> Point{num
x :: num
y :: num
y :: num
x :: num
..})
        (\Rect num
r Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} -> Rect num
r Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& (num -> Identity num) -> Rect num -> Identity (Rect num)
forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
top ((num -> Identity num) -> Rect num -> Identity (Rect num))
-> num -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> b -> s -> t
.~ num
y Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& (num -> Identity num) -> Rect num -> Identity (Rect num)
forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
right ((num -> Identity num) -> Rect num -> Identity (Rect num))
-> num -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> b -> s -> t
.~ num
x)

bottom :: Lens' (Rect num) num
bottom :: forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
bottom = (Point num -> f (Point num)) -> Rect num -> f (Rect num)
#bottomRight ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#y

right :: Lens' (Rect num) num
right :: forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
right = (Point num -> f (Point num)) -> Rect num -> f (Rect num)
#bottomRight ((Point num -> f (Point num)) -> Rect num -> f (Rect num))
-> ((num -> f num) -> Point num -> f (Point num))
-> (num -> f num)
-> Rect num
-> f (Rect num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> f num) -> Point num -> f (Point num)
#x

bottomLeft :: Lens' (Rect num) (Point num)
bottomLeft :: forall num (f :: * -> *).
Functor f =>
(Point num -> f (Point num)) -> Rect num -> f (Rect num)
bottomLeft =
    (Rect num -> Point num)
-> (Rect num -> Point num -> Rect num)
-> Lens (Rect num) (Rect num) (Point num) (Point num)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
        (\Rect{topLeft :: forall num. Rect num -> Point num
topLeft = Point{num
x :: forall num. Point num -> num
x :: num
x}, bottomRight :: forall num. Rect num -> Point num
bottomRight = Point{num
y :: forall num. Point num -> num
y :: num
y}} -> Point{num
x :: num
y :: num
x :: num
y :: num
..})
        (\Rect num
r Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} -> Rect num
r Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& (num -> Identity num) -> Rect num -> Identity (Rect num)
forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
bottom ((num -> Identity num) -> Rect num -> Identity (Rect num))
-> num -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> b -> s -> t
.~ num
y Rect num -> (Rect num -> Rect num) -> Rect num
forall a b. a -> (a -> b) -> b
& (num -> Identity num) -> Rect num -> Identity (Rect num)
forall num (f :: * -> *).
Functor f =>
(num -> f num) -> Rect num -> f (Rect num)
left ((num -> Identity num) -> Rect num -> Identity (Rect num))
-> num -> Rect num -> Rect num
forall s t a b. ASetter s t a b -> b -> s -> t
.~ num
x)

instance (Ord num) => Shape (Rect num) num where
    boundingBox :: Rect num -> Rect num
boundingBox = Identity (Rect num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects1 (Identity (Rect num) -> Rect num)
-> (Rect num -> Identity (Rect num)) -> Rect num -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Identity (Rect num)
forall a. a -> Identity a
Identity
    transform :: (Point num -> Point num) -> Rect num -> Rect num
transform Point num -> Point num
f Rect{Point num
topLeft :: forall num. Rect num -> Point num
bottomRight :: forall num. Rect num -> Point num
topLeft :: Point num
bottomRight :: Point num
..} = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints1 [(Point num -> Point num) -> Point num -> Point num
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f Point num
topLeft, (Point num -> Point num) -> Point num -> Point num
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f Point num
bottomRight]

instance (Num num, Ord num, ToMisoString num) => ToSVG (Rect num) num where
    toSVG :: forall action model.
[Attribute action] -> Rect num -> [View model action]
toSVG [Attribute action]
attrs r :: Rect num
r@Rect{topLeft :: forall num. Rect num -> Point num
topLeft = Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..}} =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> ([Attribute action] -> View model action)
-> [Attribute action]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
Svg.rect_
            ([Attribute action] -> [View model action])
-> [Attribute action] -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.x_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
x)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.y_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
y)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Html.width_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
width)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Html.height_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
height)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
      where
        (num
width, num
height) = Rect num -> (num, num)
forall num. Num num => Rect num -> (num, num)
rectSize Rect num
r

boundingBoxOfRects1 :: (Foldable f, Ord num) => f (Rect num) -> Rect num
boundingBoxOfRects1 :: forall (f :: * -> *) num.
(Foldable f, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects1 = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints1 ([Point num] -> Rect num)
-> (f (Rect num) -> [Point num]) -> f (Rect num) -> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Rect num -> [Point num]) -> f (Rect num) -> [Point num]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \Rect{Point num
topLeft :: forall num. Rect num -> Point num
bottomRight :: forall num. Rect num -> Point num
topLeft :: Point num
bottomRight :: Point num
..} -> [Point num
topLeft, Point num
bottomRight]

boundingBoxOfRects :: (Foldable f, Num num, Ord num) => f (Rect num) -> Rect num
boundingBoxOfRects :: forall (f :: * -> *) num.
(Foldable f, Num num, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects (f (Rect num) -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -> Bool
True) = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints []
boundingBoxOfRects f (Rect num)
rects = f (Rect num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects1 f (Rect num)
rects

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

data Circle num = Circle {forall num. Circle num -> Point num
centre :: Point num, forall num. Circle num -> num
radius :: num}
    deriving stock ((forall x. Circle num -> Rep (Circle num) x)
-> (forall x. Rep (Circle num) x -> Circle num)
-> Generic (Circle num)
forall x. Rep (Circle num) x -> Circle num
forall x. Circle num -> Rep (Circle num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Circle num) x -> Circle num
forall num x. Circle num -> Rep (Circle num) x
$cfrom :: forall num x. Circle num -> Rep (Circle num) x
from :: forall x. Circle num -> Rep (Circle num) x
$cto :: forall num x. Rep (Circle num) x -> Circle num
to :: forall x. Rep (Circle num) x -> Circle num
Generic)

instance (Num num) => Shape (Circle num) num where
    boundingBox :: Circle num -> Rect num
boundingBox Circle{num
Point num
centre :: forall num. Circle num -> Point num
radius :: forall num. Circle num -> num
centre :: Point num
radius :: num
..} =
        Rect
            { topLeft :: Point num
topLeft = (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
subtract num
radius) (num -> num -> num
forall a. Num a => a -> a -> a
subtract num
radius) Point num
centre
            , bottomRight :: Point num
bottomRight = (num -> num) -> (num -> num) -> Point num -> Point num
forall num. (num -> num) -> (num -> num) -> Point num -> Point num
offsetPoint (num -> num -> num
forall a. Num a => a -> a -> a
+ num
radius) (num -> num -> num
forall a. Num a => a -> a -> a
+ num
radius) Point num
centre
            }
    transform :: (Point num -> Point num) -> Circle num -> Circle num
transform Point num -> Point num
f = ASetter (Circle num) (Circle num) (Point num) (Point num)
#centre ASetter (Circle num) (Circle num) (Point num) (Point num)
-> (Point num -> Point num) -> Circle num -> Circle num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point num -> Point num
f

instance (Num num, ToMisoString num) => ToSVG (Circle num) num where
    toSVG :: forall action model.
[Attribute action] -> Circle num -> [View model action]
toSVG [Attribute action]
attrs Circle{centre :: forall num. Circle num -> Point num
centre = Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..}, num
radius :: forall num. Circle num -> num
radius :: num
radius} =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> ([Attribute action] -> View model action)
-> [Attribute action]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
Svg.rect_
            ([Attribute action] -> [View model action])
-> [Attribute action] -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.cx_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
x)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.cy_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
y)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.r_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
radius)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs

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

data Line num = Line (Point num) (Point num)
    deriving stock ((forall x. Line num -> Rep (Line num) x)
-> (forall x. Rep (Line num) x -> Line num) -> Generic (Line num)
forall x. Rep (Line num) x -> Line num
forall x. Line num -> Rep (Line num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Line num) x -> Line num
forall num x. Line num -> Rep (Line num) x
$cfrom :: forall num x. Line num -> Rep (Line num) x
from :: forall x. Line num -> Rep (Line num) x
$cto :: forall num x. Rep (Line num) x -> Line num
to :: forall x. Rep (Line num) x -> Line num
Generic)

instance (Num num, Ord num) => Shape (Line num) num where
    boundingBox :: Line num -> Rect num
boundingBox (Line Point num
p1 Point num
p2) = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints [Point num
p1, Point num
p2]
    transform :: (Point num -> Point num) -> Line num -> Line num
transform Point num -> Point num
f = ASetter
  (Line num) (Line num) (Point num, Point num) (Point num, Point num)
#Line ASetter
  (Line num) (Line num) (Point num, Point num) (Point num, Point num)
-> ((Point num, Point num) -> (Point num, Point num))
-> Line num
-> Line num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Point num -> Identity (Point num))
-> (Point num, Point num) -> Identity (Point num, Point num)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Point num, Point num)
  (Point num, Point num)
  (Point num)
  (Point num)
_1 ((Point num -> Identity (Point num))
 -> (Point num, Point num) -> Identity (Point num, Point num))
-> (Point num -> Point num)
-> (Point num, Point num)
-> (Point num, Point num)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point num -> Point num) -> Point num -> Point num
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f) ((Point num, Point num) -> (Point num, Point num))
-> ((Point num, Point num) -> (Point num, Point num))
-> (Point num, Point num)
-> (Point num, Point num)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Point num -> Identity (Point num))
-> (Point num, Point num) -> Identity (Point num, Point num)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Point num, Point num)
  (Point num, Point num)
  (Point num)
  (Point num)
_2 ((Point num -> Identity (Point num))
 -> (Point num, Point num) -> Identity (Point num, Point num))
-> (Point num -> Point num)
-> (Point num, Point num)
-> (Point num, Point num)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point num -> Point num) -> Point num -> Point num
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f)

instance (Num num, Ord num, ToMisoString num) => ToSVG (Line num) num where
    toSVG :: forall action model.
[Attribute action] -> Line num -> [View model action]
toSVG [Attribute action]
attrs (Line Point{x :: forall num. Point num -> num
x = num
x1, y :: forall num. Point num -> num
y = num
y1} Point{x :: forall num. Point num -> num
x = num
x2, y :: forall num. Point num -> num
y = num
y2}) =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> ([Attribute action] -> View model action)
-> [Attribute action]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
Miso.Svg.line_
            ([Attribute action] -> [View model action])
-> [Attribute action] -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.x1_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
x1)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.y1_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
y1)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.x2_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
x2)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.y2_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
y2)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs

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

newtype Polyline num = Polyline {forall num. Polyline num -> [Point num]
points :: [Point num]}
    deriving stock ((forall x. Polyline num -> Rep (Polyline num) x)
-> (forall x. Rep (Polyline num) x -> Polyline num)
-> Generic (Polyline num)
forall x. Rep (Polyline num) x -> Polyline num
forall x. Polyline num -> Rep (Polyline num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Polyline num) x -> Polyline num
forall num x. Polyline num -> Rep (Polyline num) x
$cfrom :: forall num x. Polyline num -> Rep (Polyline num) x
from :: forall x. Polyline num -> Rep (Polyline num) x
$cto :: forall num x. Rep (Polyline num) x -> Polyline num
to :: forall x. Rep (Polyline num) x -> Polyline num
Generic)

instance (Num num, Ord num) => Shape (Polyline num) num where
    boundingBox :: Polyline num -> Rect num
boundingBox Polyline{[Point num]
points :: forall num. Polyline num -> [Point num]
points :: [Point num]
..} = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints [Point num]
points
    transform :: (Point num -> Point num) -> Polyline num -> Polyline num
transform Point num -> Point num
f = ASetter (Polyline num) (Polyline num) [Point num] [Point num]
#Polyline ASetter (Polyline num) (Polyline num) [Point num] [Point num]
-> ([Point num] -> [Point num]) -> Polyline num -> Polyline num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point num -> Point num) -> [Point num] -> [Point num]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point num -> Point num
f

instance (Num num, Ord num, ToMisoString num) => ToSVG (Polyline num) num where
    toSVG :: forall action model.
[Attribute action] -> Polyline num -> [View model action]
toSVG [Attribute action]
attrs Polyline{[Point num]
points :: forall num. Polyline num -> [Point num]
points :: [Point num]
..} =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> ([Attribute action] -> View model action)
-> [Attribute action]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
Miso.Svg.polyline_
            ([Attribute action] -> [View model action])
-> [Attribute action] -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.points_ ([MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString) -> [MisoString] -> MisoString
forall a b. (a -> b) -> a -> b
$ Point num -> MisoString
mkPoint (Point num -> MisoString) -> [Point num] -> [MisoString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point num]
points)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
      where
        mkPoint :: Point num -> MisoString
        mkPoint :: Point num -> MisoString
mkPoint Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} = MisoString -> [MisoString] -> MisoString
MisoString.intercalate MisoString
"," ([MisoString] -> MisoString)
-> ([num] -> [MisoString]) -> [num] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> MisoString) -> [num] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([num] -> MisoString) -> [num] -> MisoString
forall a b. (a -> b) -> a -> b
$ [num
x, num
y]

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

newtype Polygon num = Polygon {forall num. Polygon num -> [Point num]
points :: [Point num]}
    deriving stock ((forall x. Polygon num -> Rep (Polygon num) x)
-> (forall x. Rep (Polygon num) x -> Polygon num)
-> Generic (Polygon num)
forall x. Rep (Polygon num) x -> Polygon num
forall x. Polygon num -> Rep (Polygon num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Polygon num) x -> Polygon num
forall num x. Polygon num -> Rep (Polygon num) x
$cfrom :: forall num x. Polygon num -> Rep (Polygon num) x
from :: forall x. Polygon num -> Rep (Polygon num) x
$cto :: forall num x. Rep (Polygon num) x -> Polygon num
to :: forall x. Rep (Polygon num) x -> Polygon num
Generic)

instance (Num num, Ord num) => Shape (Polygon num) num where
    boundingBox :: Polygon num -> Rect num
boundingBox Polygon{[Point num]
points :: forall num. Polygon num -> [Point num]
points :: [Point num]
..} = [Point num] -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (Point num) -> Rect num
boundingBoxOfPoints [Point num]
points
    transform :: (Point num -> Point num) -> Polygon num -> Polygon num
transform Point num -> Point num
f = ASetter (Polygon num) (Polygon num) [Point num] [Point num]
#Polygon ASetter (Polygon num) (Polygon num) [Point num] [Point num]
-> ([Point num] -> [Point num]) -> Polygon num -> Polygon num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point num -> Point num) -> [Point num] -> [Point num]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point num -> Point num
f

instance (Num num, Ord num, ToMisoString num) => ToSVG (Polygon num) num where
    toSVG :: forall action model.
[Attribute action] -> Polygon num -> [View model action]
toSVG [Attribute action]
attrs Polygon{[Point num]
points :: forall num. Polygon num -> [Point num]
points :: [Point num]
..} =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> ([Attribute action] -> View model action)
-> [Attribute action]
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
Miso.Svg.polygon_
            ([Attribute action] -> [View model action])
-> [Attribute action] -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.points_ ([MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString)
-> ([Point num] -> [MisoString]) -> [Point num] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Point num -> MisoString) -> [Point num] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point num -> MisoString
mkPoint ([Point num] -> MisoString) -> [Point num] -> MisoString
forall a b. (a -> b) -> a -> b
$ [Point num]
points)
            Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
      where
        mkPoint :: Point num -> MisoString
        mkPoint :: Point num -> MisoString
mkPoint Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} = MisoString -> [MisoString] -> MisoString
MisoString.intercalate MisoString
"," ([MisoString] -> MisoString)
-> ([num] -> [MisoString]) -> [num] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> MisoString) -> [num] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([num] -> MisoString) -> [num] -> MisoString
forall a b. (a -> b) -> a -> b
$ [num
x, num
y]

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

data TextAnchor
    = Start
    | Middle
    | End
    deriving stock (TextAnchor -> TextAnchor -> Bool
(TextAnchor -> TextAnchor -> Bool)
-> (TextAnchor -> TextAnchor -> Bool) -> Eq TextAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAnchor -> TextAnchor -> Bool
== :: TextAnchor -> TextAnchor -> Bool
$c/= :: TextAnchor -> TextAnchor -> Bool
/= :: TextAnchor -> TextAnchor -> Bool
Eq)

instance ToMisoString TextAnchor where
    toMisoString :: TextAnchor -> MisoString
toMisoString TextAnchor
Start = MisoString
"start"
    toMisoString TextAnchor
Middle = MisoString
"middle"
    toMisoString TextAnchor
End = MisoString
"end"

data Text num = Text
    { forall num. Text num -> Point num
position :: Point num
    , forall num. Text num -> TextAnchor
anchor :: TextAnchor
    , forall num. Text num -> MisoString
content :: MisoString
    }
    deriving stock ((forall x. Text num -> Rep (Text num) x)
-> (forall x. Rep (Text num) x -> Text num) -> Generic (Text num)
forall x. Rep (Text num) x -> Text num
forall x. Text num -> Rep (Text num) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall num x. Rep (Text num) x -> Text num
forall num x. Text num -> Rep (Text num) x
$cfrom :: forall num x. Text num -> Rep (Text num) x
from :: forall x. Text num -> Rep (Text num) x
$cto :: forall num x. Rep (Text num) x -> Text num
to :: forall x. Rep (Text num) x -> Text num
Generic)

instance Shape (Text num) num where
    boundingBox :: Text num -> Rect num
boundingBox Text{MisoString
TextAnchor
Point num
position :: forall num. Text num -> Point num
anchor :: forall num. Text num -> TextAnchor
content :: forall num. Text num -> MisoString
position :: Point num
anchor :: TextAnchor
content :: MisoString
..} = Point num -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox Point num
position
    transform :: (Point num -> Point num) -> Text num -> Text num
transform Point num -> Point num
f = ASetter (Text num) (Text num) (Point num) (Point num)
#position ASetter (Text num) (Text num) (Point num) (Point num)
-> (Point num -> Point num) -> Text num -> Text num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point num -> Point num) -> Point num -> Point num
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f

instance (ToMisoString num) => ToSVG (Text num) num where
    toSVG :: forall action model.
[Attribute action] -> Text num -> [View model action]
toSVG [Attribute action]
attrs Text{position :: forall num. Text num -> Point num
position = Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..}, MisoString
TextAnchor
anchor :: forall num. Text num -> TextAnchor
content :: forall num. Text num -> MisoString
anchor :: TextAnchor
content :: MisoString
..} =
        View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> (MisoString -> View model action)
-> MisoString
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
Svg.text_
                ( MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.x_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
x)
                    Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.y_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
y)
                    Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.textAnchor_ (TextAnchor -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString TextAnchor
anchor)
                    Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
                )
            ([View model action] -> View model action)
-> (MisoString -> [View model action])
-> MisoString
-> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (View model action -> [View model action])
-> (MisoString -> View model action)
-> MisoString
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> View model action
forall model action. MisoString -> View model action
text
            (MisoString -> [View model action])
-> MisoString -> [View model action]
forall a b. (a -> b) -> a -> b
$ MisoString
content

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

data SomeShape num = forall s. (Shape s num, ToSVG s num) => Shape s

instance Shape (SomeShape num) num where
    boundingBox :: SomeShape num -> Rect num
boundingBox (Shape s
s) = s -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox s
s
    transform :: (Point num -> Point num) -> SomeShape num -> SomeShape num
transform Point num -> Point num
f (Shape s
s) = s -> SomeShape num
forall num s. (Shape s num, ToSVG s num) => s -> SomeShape num
Shape (s -> SomeShape num) -> s -> SomeShape num
forall a b. (a -> b) -> a -> b
$ (Point num -> Point num) -> s -> s
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform Point num -> Point num
f s
s

instance ToSVG (SomeShape num) num where
    toSVG :: forall action model.
[Attribute action] -> SomeShape num -> [View model action]
toSVG [Attribute action]
attrs (Shape s
s) = [Attribute action] -> s -> [View model action]
forall action model. [Attribute action] -> s -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG [Attribute action]
attrs s
s

boundingBoxOfShapes
    :: (Foldable f, Functor f, Num num, Ord num) => f (SomeShape num) -> Rect num
boundingBoxOfShapes :: forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (SomeShape num) -> Rect num
boundingBoxOfShapes = f (Rect num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Num num, Ord num) =>
f (Rect num) -> Rect num
boundingBoxOfRects (f (Rect num) -> Rect num)
-> (f (SomeShape num) -> f (Rect num))
-> f (SomeShape num)
-> Rect num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SomeShape num -> Rect num) -> f (SomeShape num) -> f (Rect num)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeShape num -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox

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

svg
    :: ( Foldable t
       , Functor t
       , Fractional num
       , Ord num
       , ToMisoString num
       )
    => Rect num
    -> [Attribute action]
    -> t (SomeShape num)
    -> View model action
svg :: forall (t :: * -> *) num action model.
(Foldable t, Functor t, Fractional num, Ord num,
 ToMisoString num) =>
Rect num
-> [Attribute action] -> t (SomeShape num) -> View model action
svg Rect num
viewBox [Attribute action]
attrs t (SomeShape num)
shapes =
    [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
Svg.svg_
        ( let
            Point{num
x :: forall num. Point num -> num
y :: forall num. Point num -> num
x :: num
y :: num
..} = Rect num -> Point num
forall num. Rect num -> Point num
topLeft Rect num
viewBox
            (num
width, num
height) = Rect num -> (num, num)
forall num. Num num => Rect num -> (num, num)
rectSize Rect num
viewBox
           in
            MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.width_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
width)
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.height_ (num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString num
height)
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: MisoString -> Attribute action
forall action. MisoString -> Attribute action
Svg.viewBox_ ([MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString)
-> ([num] -> [MisoString]) -> [num] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> MisoString) -> [num] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap num -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([num] -> MisoString) -> [num] -> MisoString
forall a b. (a -> b) -> a -> b
$ [num
x, num
y, num
width, num
height])
                Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs
        )
        ([View model action] -> View model action)
-> (t (SomeShape num) -> [View model action])
-> t (SomeShape num)
-> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SomeShape num -> [View model action])
-> t (SomeShape num) -> [View model action]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Attribute action] -> SomeShape num -> [View model action]
forall action model.
[Attribute action] -> SomeShape num -> [View model action]
forall s num action model.
ToSVG s num =>
[Attribute action] -> s -> [View model action]
toSVG [] (SomeShape num -> [View model action])
-> (SomeShape num -> SomeShape num)
-> SomeShape num
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rect num -> Rect num -> SomeShape num -> SomeShape num
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
viewBox Rect num
domain)
        (t (SomeShape num) -> View model action)
-> t (SomeShape num) -> View model action
forall a b. (a -> b) -> a -> b
$ t (SomeShape num)
shapes
  where
    domain :: Rect num
domain = t (SomeShape num) -> Rect num
forall (f :: * -> *) num.
(Foldable f, Functor f, Num num, Ord num) =>
f (SomeShape num) -> Rect num
boundingBoxOfShapes t (SomeShape num)
shapes

translateDomain
    :: forall s num
     . (Shape s num, Eq num, Fractional num) => Rect num -> Rect num -> s -> s
translateDomain :: forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
sup Rect num
sub = (Point num -> Point num) -> s -> s
forall s num. Shape s num => (Point num -> Point num) -> s -> s
transform ((Point num -> Point num) -> s -> s)
-> (Point num -> Point num) -> s -> s
forall a b. (a -> b) -> a -> b
$ Lens' (Point num) num -> Point num -> Point num
translate (num -> f num) -> Point num -> f (Point num)
Lens' (Point num) num
#x (Point num -> Point num)
-> (Point num -> Point num) -> Point num -> Point num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lens' (Point num) num -> Point num -> Point num
translate (num -> f num) -> Point num -> f (Point num)
Lens' (Point num) num
#y
  where
    minMax :: Lens' (Point num) num -> Rect num -> (num, num)
    minMax :: Lens' (Point num) num -> Rect num -> (num, num)
minMax Lens' (Point num) num
dim Rect num
rect = (Rect num
rect Rect num -> Getting num (Rect num) num -> num
forall s a. s -> Getting a s a -> a
^. (Point num -> Const num (Point num))
-> Rect num -> Const num (Rect num)
#topLeft ((Point num -> Const num (Point num))
 -> Rect num -> Const num (Rect num))
-> ((num -> Const num num) -> Point num -> Const num (Point num))
-> Getting num (Rect num) num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> Const num num) -> Point num -> Const num (Point num)
Lens' (Point num) num
dim, Rect num
rect Rect num -> Getting num (Rect num) num -> num
forall s a. s -> Getting a s a -> a
^. (Point num -> Const num (Point num))
-> Rect num -> Const num (Rect num)
#bottomRight ((Point num -> Const num (Point num))
 -> Rect num -> Const num (Rect num))
-> ((num -> Const num num) -> Point num -> Const num (Point num))
-> Getting num (Rect num) num
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (num -> Const num num) -> Point num -> Const num (Point num)
Lens' (Point num) num
dim)
    translate :: Lens' (Point num) num -> Point num -> Point num
    translate :: Lens' (Point num) num -> Point num -> Point num
translate Lens' (Point num) num
dim =
        let
            (num
dMin, num
dMax) = Lens' (Point num) num -> Rect num -> (num, num)
minMax (num -> f num) -> Point num -> f (Point num)
Lens' (Point num) num
dim Rect num
sub
            (num
vMin, num
vMax) = Lens' (Point num) num -> Rect num -> (num, num)
minMax (num -> f num) -> Point num -> f (Point num)
Lens' (Point num) num
dim Rect num
sup
         in
            (num -> Identity num) -> Point num -> Identity (Point num)
Lens' (Point num) num
dim ((num -> Identity num) -> Point num -> Identity (Point num))
-> (num -> num) -> Point num -> Point num
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \num
x ->
                if num
dMax num -> num -> Bool
forall a. Eq a => a -> a -> Bool
== num
dMin
                    then num
vMin
                    else num
vMin num -> num -> num
forall a. Num a => a -> a -> a
+ (num
x num -> num -> num
forall a. Num a => a -> a -> a
- num
dMin) num -> num -> num
forall a. Num a => a -> a -> a
* (num
vMax num -> num -> num
forall a. Num a => a -> a -> a
- num
vMin) num -> num -> num
forall a. Fractional a => a -> a -> a
/ (num
dMax num -> num -> num
forall a. Num a => a -> a -> a
- num
dMin)

inDomain :: (Shape s num, Ord num, Fractional num) => Rect num -> s -> s
inDomain :: forall s num.
(Shape s num, Ord num, Fractional num) =>
Rect num -> s -> s
inDomain Rect num
d s
s = Rect num -> Rect num -> s -> s
forall s num.
(Shape s num, Eq num, Fractional num) =>
Rect num -> Rect num -> s -> s
translateDomain Rect num
d (s -> Rect num
forall s num. Shape s num => s -> Rect num
boundingBox s
s) s
s