{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE AllowAmbiguousTypes          #-}
{-# LANGUAGE QuantifiedConstraints          #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Miso.Svg.Writer
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Render geometric objects to Svg files through miso
--
--------------------------------------------------------------------------------
module HGeometry.Miso.Svg.Writer
  ( withAts
  , Drawable(..)

  , dPoint
  , dLineSegment
  , dRectangle
  , dCircle
  , dDisk
  , dPolyLine
  , dSimplePolygon
  ) where

import           Control.Lens
import qualified Data.Foldable as F
import           HGeometry.Ball
import           HGeometry.Box
import           HGeometry.Ext
import           HGeometry.Foldable.Util
import           HGeometry.LineSegment
import           HGeometry.Miso.OrphanInstances ()
import           HGeometry.Point
import           HGeometry.PolyLine
import           HGeometry.Polygon.Convex
import           HGeometry.Polygon.Simple
import           HGeometry.Vector
import qualified Ipe
import           Ipe.Attributes
import           Miso (Attribute, View, text)
import           Miso.String (MisoString, ToMisoString(..), ms)
import qualified Miso.String.Util as MisoString
import           Miso.Svg
import           Miso.Svg.Property
import           Miso.Html.Property (width_,height_) -- not sure if this is correct (namespace)!
import           Barbies

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


-- | Helper function to construct drawing functions. I..e it allows
-- you do pre-specify a bunch of attributes that should be drawn
-- (ats1) yet allow more attributes to be added by the user later.
withAts             ::  ([Attribute action] -> View model action)
                    -> [Attribute action] -> [Attribute action] -> View model action
withAts :: forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
f [Attribute action]
ats1 [Attribute action]
ats2 = [Attribute action] -> View model action
f ([Attribute action]
ats1 [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
ats2)

-- -- | Helper function to construct a View. See 'withAts' for its usage.
-- withAts'             :: ([Attribute action] -> View model action)
--                      -> [Attribute action]
--                      -> [Attribute action]
--                      -> View model action
-- withAts' f ats1 ats2 = f (ats1 <> ats2)

--------------------------------------------------------------------------------
-- * Default implementations for drawing geometric objects

-- | Default implementation for drawing geometric objects
class Drawable t where
  {-# MINIMAL draw | drawWith #-}
  -- | Draws the given object with the given attributes
  draw       :: t -> [Attribute action] -> View model action
  draw t
x [Attribute action]
ats = t -> [Attribute action] -> [View model action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> [View model action] -> View model action
forall action model.
t -> [Attribute action] -> [View model action] -> View model action
drawWith t
x [Attribute action]
ats []

  -- | draw the given object, as well as the given "children"
  drawWith          :: t -> [Attribute action] -> [View model action] -> View model action
  drawWith t
x [Attribute action]
ats [View model action]
_b = t -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model. t -> [Attribute action] -> View model action
draw t
x [Attribute action]
ats

instance (Drawable l, Drawable r) => Drawable (Either l r) where
  draw :: forall action model.
Either l r -> [Attribute action] -> View model action
draw = (l -> [Attribute action] -> View model action)
-> (r -> [Attribute action] -> View model action)
-> Either l r
-> [Attribute action]
-> View model action
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either l -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model. l -> [Attribute action] -> View model action
draw r -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model. r -> [Attribute action] -> View model action
draw

instance ToMisoString r => Drawable (Point 2 r) where
  draw :: forall action model.
Point 2 r -> [Attribute action] -> View model action
draw = Point 2 r -> [Attribute action] -> View model action
forall point r action model.
(Point_ point 2 r, ToMisoString r) =>
point -> [Attribute action] -> View model action
dPoint

instance (Point_ point 2 r, ToMisoString r, Num r) => Drawable (Rectangle point) where
  draw :: forall action model.
Rectangle point -> [Attribute action] -> View model action
draw = Rectangle point -> [Attribute action] -> View model action
forall rectangle point r action model.
(Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r,
 Num r) =>
rectangle -> [Attribute action] -> View model action
dRectangle

instance ( Point_ point 2 r, EndPoint_ (endPoint point), IxValue (endPoint point) ~ point
         , ToMisoString r) => Drawable (LineSegment endPoint point) where
  draw :: forall action model.
LineSegment endPoint point
-> [Attribute action] -> View model action
draw = LineSegment endPoint point
-> [Attribute action] -> View model action
forall lineSegment point r action model.
(LineSegment_ lineSegment point, Point_ point 2 r,
 ToMisoString r) =>
lineSegment -> [Attribute action] -> View model action
dLineSegment

instance ( Point_ point 2 r, ToMisoString r
         , Traversable1 f
         , Ixed (f point), IxValue (f point) ~ point, Index (f point) ~ Int
         , HasFromFoldable1 f
         , TraversableWithIndex Int f
         ) => Drawable (PolyLineF f point) where
  draw :: forall action model.
PolyLineF f point -> [Attribute action] -> View model action
draw = PolyLineF f point -> [Attribute action] -> View model action
forall polyLine point r action model.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine -> [Attribute action] -> View model action
dPolyLine

instance ( Point_ point 2 r, VertexContainer f point, HasFromFoldable1 f
         , ToMisoString r) => Drawable (SimplePolygonF f point) where
 draw :: forall action model.
SimplePolygonF f point -> [Attribute action] -> View model action
draw = SimplePolygonF f point -> [Attribute action] -> View model action
forall simplePolygon point r action model.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon -> [Attribute action] -> View model action
dSimplePolygon

instance ( Point_ point 2 r, VertexContainer f point, HasFromFoldable1 f
         , ToMisoString r) => Drawable (ConvexPolygonF f point) where
  draw :: forall action model.
ConvexPolygonF f point -> [Attribute action] -> View model action
draw = SimplePolygonF f point -> [Attribute action] -> View model action
forall simplePolygon point r action model.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon -> [Attribute action] -> View model action
dSimplePolygon (SimplePolygonF f point -> [Attribute action] -> View model action)
-> (ConvexPolygonF f point -> SimplePolygonF f point)
-> ConvexPolygonF f point
-> [Attribute action]
-> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvexPolygonF f point -> SimplePolygonF f point
forall {k} (f :: k -> *) (point :: k).
ConvexPolygonF f point -> SimplePolygonF f point
toSimplePolygon

instance (Point_ point 2 r, ToMisoString r, Floating r) => Drawable (Circle point) where
  draw :: forall action model.
Circle point -> [Attribute action] -> View model action
draw = Circle point -> [Attribute action] -> View model action
forall point r action model.
(Point_ point 2 r, ToMisoString r) =>
Circle point -> [Attribute action] -> View model action
dCircle

instance (Point_ point 2 r, ToMisoString r, Floating r) => Drawable (Disk point) where
  draw :: forall action model.
Disk point -> [Attribute action] -> View model action
draw = Disk point -> [Attribute action] -> View model action
forall disk point r action model.
(Disk_ disk point, ConstructableBall_ disk point, Point_ point 2 r,
 ToMisoString r, Floating r) =>
disk -> [Attribute action] -> View model action
dDisk

-- instance ToMisoString r => Drawable (Viewport r) where
--   draw = error
--   drawWith vp ats content = withAts' svg_ [ height_ $ ms h <> "px"
--                                           , viewbox_ outerVB
--                                           ] ats
--                                           [ g_ [] -- do the transorm here
--                                                [ svg_ [ width_ "100%"
--                                                       , height "100%"
--                                                       , viewbox innerVB
--                                                       ]
--                                                       content
--                                                ]
--                                           ]
--     where
--       toVB = MisoString.unwords . map ms
--       outerVB = toVB [0, (-1) * h, w, h]
--             -- the role of the outer viewBox is to flip the coordinate
--             -- system s.t. the origin is in the bottom left rather
--             -- than the top-left
--       innerVB = toVB [lx, ly, vw, vh]




--------------------------------------------------------------------------------
-- * Functions to draw geometric objects

-- | Draw a point
dPoint   :: (Point_ point 2 r, ToMisoString r) => point -> [Attribute action] -> View model action
dPoint :: forall point r action model.
(Point_ point 2 r, ToMisoString r) =>
point -> [Attribute action] -> View model action
dPoint point
p = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
ellipse_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
cx_ (r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> r -> MisoString
forall a b. (a -> b) -> a -> b
$ point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord), MisoString -> Attribute action
forall action. MisoString -> Attribute action
cy_ (r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> r -> MisoString
forall a b. (a -> b) -> a -> b
$ point
ppoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord)
                            , MisoString -> Attribute action
forall action. MisoString -> Attribute action
rx_ MisoString
"5", MisoString -> Attribute action
forall action. MisoString -> Attribute action
ry_ MisoString
"5"
                            ]

-- | Draw a rectangle
dRectangle   :: ( Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r, Num r)
             => rectangle -> [Attribute action] -> View model action
dRectangle :: forall rectangle point r action model.
(Rectangle_ rectangle point, Point_ point 2 r, ToMisoString r,
 Num r) =>
rectangle -> [Attribute action] -> View model action
dRectangle rectangle
b = let Point2 MisoString
x MisoString
y  = ASetter (Point 2 r) (Point 2 MisoString) r MisoString
-> (r -> MisoString) -> Point 2 r -> Point 2 MisoString
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Point 2 r) (Point 2 MisoString) r MisoString
(NumType (Point 2 r) -> Identity (NumType (Point 2 MisoString)))
-> Point 2 r -> Identity (Point 2 MisoString)
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (Point 2 r)
  (Point 2 MisoString)
  (NumType (Point 2 r))
  (NumType (Point 2 MisoString))
coordinates r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Point 2 r -> Point 2 MisoString)
-> Point 2 r -> Point 2 MisoString
forall a b. (a -> b) -> a -> b
$ rectangle
brectangle -> Getting (Point 2 r) rectangle (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> rectangle -> Const (Point 2 r) rectangle
forall box point. HasMinPoint box point => Lens' box point
Lens' rectangle point
minPoint((point -> Const (Point 2 r) point)
 -> rectangle -> Const (Point 2 r) rectangle)
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) rectangle (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
                   Vector2 MisoString
w MisoString
h = r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> MisoString) -> Vector 2 r -> Vector 2 MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rectangle
brectangle
-> Getting (Vector 2 r) rectangle (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.(rectangle -> Vector 2 r)
-> Getting (Vector 2 r) rectangle (Vector 2 r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to rectangle -> Vector 2 r
forall box (d :: Nat) point r.
(Box_ box point, Point_ point d r, Num r, Functor (Vector d)) =>
box -> Vector d r
size
               in ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
rect_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
x_ MisoString
x, MisoString -> Attribute action
forall action. MisoString -> Attribute action
y_ MisoString
y, MisoString -> Attribute action
forall action. MisoString -> Attribute action
width_ MisoString
w, MisoString -> Attribute action
forall action. MisoString -> Attribute action
height_ MisoString
h, MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_ MisoString
"none"]

-- | Draw a simple polygon
dSimplePolygon    :: (SimplePolygon_ simplePolygon point r, ToMisoString r)
                  => simplePolygon -> [Attribute action] -> View model action
dSimplePolygon :: forall simplePolygon point r action model.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon -> [Attribute action] -> View model action
dSimplePolygon simplePolygon
pg = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
polygon_ [MisoString -> Attribute action
forall action. MisoString -> Attribute action
points_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString ([point] -> MisoString) -> [point] -> MisoString
forall a b. (a -> b) -> a -> b
$ simplePolygon
pgsimplePolygon
-> Getting (Endo [point]) simplePolygon point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) simplePolygon point
(Vertex simplePolygon
 -> Const (Endo [point]) (Vertex simplePolygon))
-> simplePolygon -> Const (Endo [point]) simplePolygon
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx simplePolygon)
  simplePolygon
  simplePolygon
  (Vertex simplePolygon)
  (Vertex simplePolygon)
vertices ]


  -- \case
  --   SimplePolygon vs   ->
  --   MultiPolygon vs hs -> withAts path_ [d_ s]
  --     where
  --       s = mconcat . map toSimplePolygonPathString $ vs : hs


-- toSimplePolygonPathString                    :: ToMisoString r => SimplePolygon p r -> MisoString
-- toSimplePolygonPathString (SimplePolygon vs) = mconcat [ "M", toOp p
--                                                        , mconcat $ map (\q -> "L" <> toOp q) ps
--                                                        , "Z"
--                                                        ]
  -- where
  --   p :| ps = F1.toNonEmpty vs
  --   toOp (Point2 x y :+ _) = ms x <> " " <> ms y <> " "


-- | Draw a polyline
dPolyLine    :: (PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r)
             => polyLine -> [Attribute action] -> View model action
dPolyLine :: forall polyLine point r action model.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine -> [Attribute action] -> View model action
dPolyLine polyLine
pl = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
polyline_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
points_ (MisoString -> Attribute action)
-> ([point] -> MisoString) -> [point] -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString ([point] -> Attribute action) -> [point] -> Attribute action
forall a b. (a -> b) -> a -> b
$ polyLine
plpolyLine -> Getting (Endo [point]) polyLine point -> [point]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^..Getting (Endo [point]) polyLine point
(Vertex polyLine -> Const (Endo [point]) (Vertex polyLine))
-> polyLine -> Const (Endo [point]) polyLine
forall graph graph'.
HasVertices graph graph' =>
IndexedTraversal1
  (VertexIx graph) graph graph' (Vertex graph) (Vertex graph')
IndexedTraversal1
  (VertexIx polyLine)
  polyLine
  polyLine
  (Vertex polyLine)
  (Vertex polyLine)
vertices
                                 , MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_ MisoString
"none"
                                 ]

-- | Draw a line segment
dLineSegment   :: ( LineSegment_ lineSegment point, Point_ point 2 r, ToMisoString r)
               => lineSegment -> [Attribute action] -> View model action
dLineSegment :: forall lineSegment point r action model.
(LineSegment_ lineSegment point, Point_ point 2 r,
 ToMisoString r) =>
lineSegment -> [Attribute action] -> View model action
dLineSegment lineSegment
s = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
polyline_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
points_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ [point] -> MisoString
forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString [lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start, lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end] ]

-- | constructs a list of points to be used in the 'points' svg attribute.
toPointsString :: (Point_ point 2 r, ToMisoString r, Foldable f) => f point -> MisoString
toPointsString :: forall point r (f :: * -> *).
(Point_ point 2 r, ToMisoString r, Foldable f) =>
f point -> MisoString
toPointsString =
  [MisoString] -> MisoString
MisoString.unwords ([MisoString] -> MisoString)
-> (f point -> [MisoString]) -> f point -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (point -> MisoString) -> [point] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
map (\(Point2_ r
x r
y) -> [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat [r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
x, MisoString
",", r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
y]) ([point] -> [MisoString])
-> (f point -> [point]) -> f point -> [MisoString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f point -> [point]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList


-- | Draw a circle
dCircle              :: (Point_ point 2 r, ToMisoString r)
                     => Circle point -> [Attribute action] -> View model action
dCircle :: forall point r action model.
(Point_ point 2 r, ToMisoString r) =>
Circle point -> [Attribute action] -> View model action
dCircle (Circle point
c NumType point
r) = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
ellipse_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
rx_ (MisoString -> Attribute action)
-> (NumType point -> MisoString)
-> NumType point
-> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
NumType point -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (NumType point -> Attribute action)
-> NumType point -> Attribute action
forall a b. (a -> b) -> a -> b
$ NumType point
r
                                         , MisoString -> Attribute action
forall action. MisoString -> Attribute action
ry_ (MisoString -> Attribute action)
-> (NumType point -> MisoString)
-> NumType point
-> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
NumType point -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (NumType point -> Attribute action)
-> NumType point -> Attribute action
forall a b. (a -> b) -> a -> b
$ NumType point
r
                                         , MisoString -> Attribute action
forall action. MisoString -> Attribute action
cx_ (MisoString -> Attribute action)
-> (r -> MisoString) -> r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute action) -> r -> Attribute action
forall a b. (a -> b) -> a -> b
$ point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord
                                         , MisoString -> Attribute action
forall action. MisoString -> Attribute action
cy_ (MisoString -> Attribute action)
-> (r -> MisoString) -> r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute action) -> r -> Attribute action
forall a b. (a -> b) -> a -> b
$ point
cpoint -> Getting r point r -> r
forall s a. s -> Getting a s a -> a
^.Getting r point r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord
                                         , MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_ MisoString
"none"
                                         ]

-- | Draw a disk
dDisk             :: ( Disk_ disk point, ConstructableBall_ disk point
                     , Point_ point 2 r, ToMisoString r, Floating r)
                  => disk -> [Attribute action] -> View model action
dDisk :: forall disk point r action model.
(Disk_ disk point, ConstructableBall_ disk point, Point_ point 2 r,
 ToMisoString r, Floating r) =>
disk -> [Attribute action] -> View model action
dDisk (Disk_ point
c NumType disk
r) = Circle point -> [Attribute action] -> View model action
forall point r action model.
(Point_ point 2 r, ToMisoString r) =>
Circle point -> [Attribute action] -> View model action
dCircle (point -> NumType point -> Circle point
forall point. point -> NumType point -> Circle point
Circle point
c NumType disk
NumType point
r)

-- instance (ToMisoString r, Drawable v, Drawable  => Drawable (PlanarSubdivision s v e f r)


-- dPlanarSubdivision        :: PlanarSubdivision s (Maybe (View model action))
--                                                  (Maybe (View model action))
--                                                  (Maybe (View model action)) r
--                           -> [Attribute action] -> View model action
-- dPlanarSubdivision = dPlanarSubdivisionWith (^._2.vData) (^._2.extra) (^._2.extra)


-- -- | Draws only the values for which we have a Just attribute
-- dPlanarSubdivision' :: (ToMisoString r)
--                     => PlanarSubdivision s (Maybe (Ipe.IpeAttributes Ipe.IpeSymbol r))
--                                            (Maybe (Ipe.IpeAttributes Ipe.Path r))
--                                            (Maybe (Ipe.IpeAttributes Ipe.Path r)) r
--                     -> [Attribute action]
--                     -> View model action
-- dPlanarSubdivision' = dPlanarSubdivisionWith fv fe ff
--   where
--     fv (_,v) = (\ats -> draw (v^.location) (svgWriteAttrs ats)) <$> v^.vData
--     fe (_,e) = (\ats -> draw (e^.core)     (svgWriteAttrs ats)) <$> e^.extra
--     ff (_,f) = (\ats -> draw (f^.core)     (svgWriteAttrs ats)) <$> f^.extra


-- type DrawF a action = a -> Maybe (View model action)

-- dPlanarSubdivisionWith                 :: DrawF (VertexId' s, VertexData r v)          action
--                                        -> DrawF (Dart s,      LineSegment 2 v r :+ e)  action
--                                        -> DrawF (FaceId' s,   SomePolygon v r :+ f)    action
--                                        -> PlanarSubdivision s v e f r
--                                        -> [Attribute action]
--                                        -> View model action
-- dPlanarSubdivisionWith fv fe ff ps ats = g_ ats (fs <> es <> vs)
--     -- draw faces at the bottom, then edges, and finally the vertices
--   where
--     vs = mapMaybe fv . F.toList . vertices        $ ps
--     es = mapMaybe fe . F.toList . edgeSegments    $ ps
--     fs = mapMaybe ff . F.toList . rawFacePolygons $ ps

--------------------------------------------------------------------------------
-- * Functions to draw ipe objects

instance ToMisoString r => Drawable (Ipe.IpeObject r) where
  draw :: forall action model.
IpeObject r -> [Attribute action] -> View model action
draw = \case
    Ipe.IpeGroup IpeObject' Group r
g     -> (Group r :+ GroupAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(Group r :+ GroupAttributes r)
-> [Attribute action] -> View model action
draw Group r :+ GroupAttributes r
IpeObject' Group r
g
    Ipe.IpeImage IpeObject' Image r
i     -> (Image r :+ ImageAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(Image r :+ ImageAttributes r)
-> [Attribute action] -> View model action
draw Image r :+ ImageAttributes r
IpeObject' Image r
i
    Ipe.IpeTextLabel IpeObject' TextLabel r
t -> (TextLabel r :+ TextAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(TextLabel r :+ TextAttributes r)
-> [Attribute action] -> View model action
draw TextLabel r :+ TextAttributes r
IpeObject' TextLabel r
t
    Ipe.IpeMiniPage IpeObject' MiniPage r
m  -> (MiniPage r :+ TextAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(MiniPage r :+ TextAttributes r)
-> [Attribute action] -> View model action
draw MiniPage r :+ TextAttributes r
IpeObject' MiniPage r
m
    Ipe.IpeUse IpeObject' IpeSymbol r
u       -> (IpeSymbol r :+ SymbolAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(IpeSymbol r :+ SymbolAttributes r)
-> [Attribute action] -> View model action
draw IpeSymbol r :+ SymbolAttributes r
IpeObject' IpeSymbol r
u
    Ipe.IpePath IpeObject' Path r
p      -> (Path r :+ PathAttributes r)
-> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
(Path r :+ PathAttributes r)
-> [Attribute action] -> View model action
draw Path r :+ PathAttributes r
IpeObject' Path r
p

instance ( Drawable g
         , ToMisoString r
         , forall action. SvgWriteAttributes (ats r) action
         ) => Drawable (g :+ ats r Maybe) where
  draw :: forall action model.
(g :+ ats r Maybe) -> [Attribute action] -> View model action
draw (g
i :+ ats r Maybe
iAts) [Attribute action]
ats = g -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model. g -> [Attribute action] -> View model action
draw g
i (forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats Maybe -> [Attribute action]
svgWriteAttrs @(ats r) ats r Maybe
iAts [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
ats)




instance ToMisoString r => Drawable (Ipe.Group r) where
  draw :: forall action model.
Group r -> [Attribute action] -> View model action
draw (Ipe.Group [IpeObject r]
os) [Attribute action]
ats = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
g_ [Attribute action]
ats ((IpeObject r -> View model action)
-> [IpeObject r] -> [View model action]
forall a b. (a -> b) -> [a] -> [b]
map ((IpeObject r -> [Attribute action] -> View model action)
-> [Attribute action] -> IpeObject r -> View model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip IpeObject r -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
IpeObject r -> [Attribute action] -> View model action
draw []) [IpeObject r]
os)

instance ToMisoString r => Drawable (Ipe.Image r) where
  draw :: forall action model.
Image r -> [Attribute action] -> View model action
draw Image r
_ [Attribute action]
ats = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
text_ [Attribute action]
ats [MisoString -> View model action
forall model action. MisoString -> View model action
text MisoString
"image"]
instance ToMisoString r => Drawable (Ipe.TextLabel r) where
  draw :: forall action model.
TextLabel r -> [Attribute action] -> View model action
draw (Ipe.Label MisoString
t Point 2 r
p) [Attribute action]
ats = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
text_ ([ MisoString -> Attribute action
forall action. MisoString -> Attribute action
transform_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Point 2 r -> MisoString
forall r. ToMisoString r => Point 2 r -> MisoString
moveTo Point 2 r
p ] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
ats) [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 -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
t ]
instance ToMisoString r => Drawable (Ipe.MiniPage r) where
  draw :: forall action model.
MiniPage r -> [Attribute action] -> View model action
draw (Ipe.MiniPage MisoString
t Point 2 r
p r
w) [Attribute action]
ats = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
text_ ([ MisoString -> Attribute action
forall action. MisoString -> Attribute action
transform_ (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ Point 2 r -> MisoString
forall r. ToMisoString r => Point 2 r -> MisoString
moveTo Point 2 r
p
                                         , MisoString -> Attribute action
forall action. MisoString -> Attribute action
width_     (MisoString -> Attribute action) -> MisoString -> Attribute action
forall a b. (a -> b) -> a -> b
$ r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms r
w
                                         ] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action]
ats)
                                        [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 -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
t]

-- | renders a translation matrix
moveTo :: ToMisoString r => Point 2 r -> MisoString
moveTo :: forall r. ToMisoString r => Point 2 r -> MisoString
moveTo (ASetter (Point 2 r) (Point 2 MisoString) r MisoString
-> (r -> MisoString) -> Point 2 r -> Point 2 MisoString
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Point 2 r) (Point 2 MisoString) r MisoString
(NumType (Point 2 r) -> Identity (NumType (Point 2 MisoString)))
-> Point 2 r -> Identity (Point 2 MisoString)
forall point point'.
HasCoordinates point point' =>
IndexedTraversal1 Int point point' (NumType point) (NumType point')
IndexedTraversal1
  Int
  (Point 2 r)
  (Point 2 MisoString)
  (NumType (Point 2 r))
  (NumType (Point 2 MisoString))
coordinates r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms -> Point2 MisoString
x MisoString
y) = MisoString
"translate(" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
y MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
")"

instance ToMisoString r => Drawable (Ipe.IpeSymbol r) where
  draw :: forall action model.
IpeSymbol r -> [Attribute action] -> View model action
draw (Ipe.Symbol Point 2 r
p MisoString
_ ) = ([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
forall action model.
([Attribute action] -> View model action)
-> [Attribute action] -> [Attribute action] -> View model action
withAts [Attribute action] -> View model action
forall action model. [Attribute action] -> View model action
ellipse_ [ MisoString -> Attribute action
forall action. MisoString -> Attribute action
rx_ MisoString
r
                                            , MisoString -> Attribute action
forall action. MisoString -> Attribute action
ry_ MisoString
r
                                            , MisoString -> Attribute action
forall action. MisoString -> Attribute action
cx_ (MisoString -> Attribute action)
-> (r -> MisoString) -> r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute action) -> r -> Attribute action
forall a b. (a -> b) -> a -> b
$ Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord
                                            , MisoString -> Attribute action
forall action. MisoString -> Attribute action
cy_ (MisoString -> Attribute action)
-> (r -> MisoString) -> r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (r -> Attribute action) -> r -> Attribute action
forall a b. (a -> b) -> a -> b
$ Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
yCoord
                                            ]
    where
      r :: MisoString
r = MisoString
"5"

instance ToMisoString r => Drawable (Ipe.Path r) where
  draw :: forall action model.
Path r -> [Attribute action] -> View model action
draw (Ipe.Path Seq (PathSegment r)
s) [Attribute action]
ats = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
g_ [] ((PathSegment r -> View model action)
-> [PathSegment r] -> [View model action]
forall a b. (a -> b) -> [a] -> [b]
map ((PathSegment r -> [Attribute action] -> View model action)
-> [Attribute action] -> PathSegment r -> View model action
forall a b c. (a -> b -> c) -> b -> a -> c
flip PathSegment r -> [Attribute action] -> View model action
forall t action model.
Drawable t =>
t -> [Attribute action] -> View model action
forall action model.
PathSegment r -> [Attribute action] -> View model action
draw (MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_ MisoString
"none"Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
:[Attribute action]
ats)) ([PathSegment r] -> [View model action])
-> (Seq (PathSegment r) -> [PathSegment r])
-> Seq (PathSegment r)
-> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (PathSegment r) -> [PathSegment r]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (PathSegment r) -> [View model action])
-> Seq (PathSegment r) -> [View model action]
forall a b. (a -> b) -> a -> b
$ Seq (PathSegment r)
s)
  -- svg fills paths by default; don't do that unless specified otherwise

instance ToMisoString r => Drawable (Ipe.PathSegment r) where
  draw :: forall action model.
PathSegment r -> [Attribute action] -> View model action
draw = \case
    Ipe.PolyLineSegment PolyLine (Point 2 r)
pl -> PolyLine (Point 2 r) -> [Attribute action] -> View model action
forall polyLine point r action model.
(PolyLine_ polyLine point, Point_ point 2 r, ToMisoString r) =>
polyLine -> [Attribute action] -> View model action
dPolyLine PolyLine (Point 2 r)
pl
    Ipe.PolygonPath Orientation
_ SimplePolygon (Point 2 r)
pg   -> SimplePolygon (Point 2 r)
-> [Attribute action] -> View model action
forall simplePolygon point r action model.
(SimplePolygon_ simplePolygon point r, ToMisoString r) =>
simplePolygon -> [Attribute action] -> View model action
dSimplePolygon SimplePolygon (Point 2 r)
pg -- TODO: maybe don't ignore the orientation
    PathSegment r
_                      -> String -> [Attribute action] -> View model action
forall a. HasCallStack => String -> a
error String
"toValue: not implemented yet"




--------------------------------------------------------------------------------
-- * Dealing with attributes



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


newtype SvgF action val = SvgF (val -> [Attribute action])



  -- MisoString -> Attribute action

class SvgWriteAttributes ats action where
  svgAttrFunctions :: ats (SvgF action)
  -- | Write the attributes to file
  svgWriteAttrs :: ats Maybe -> [Attribute action]
  default svgWriteAttrs :: (ApplicativeB ats, TraversableB ats) => ats Maybe -> [Attribute action]
  svgWriteAttrs = (forall a. Const [Attribute action] a -> [Attribute action])
-> ats (Const [Attribute action]) -> [Attribute action]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap Const [Attribute action] a -> [Attribute action]
forall a. Const [Attribute action] a -> [Attribute action]
forall {k} a (b :: k). Const a b -> a
getConst
                (ats (Const [Attribute action]) -> [Attribute action])
-> (ats Maybe -> ats (Const [Attribute action]))
-> ats Maybe
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. SvgF action a -> Maybe a -> Const [Attribute action] a)
-> ats (SvgF action) -> ats Maybe -> ats (Const [Attribute action])
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith SvgF action a -> Maybe a -> Const [Attribute action] a
forall a. SvgF action a -> Maybe a -> Const [Attribute action] a
forall action a.
SvgF action a -> Maybe a -> Const [Attribute action] a
writeAttr ats (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions

singleton :: a -> [a]
singleton :: forall a. a -> [a]
singleton = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])

instance SvgWriteAttributes (CommonAttributes r) action where
  svgAttrFunctions :: CommonAttributes r (SvgF action)
svgAttrFunctions = (forall a. SvgF action a) -> CommonAttributes r (SvgF action)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
forall (f :: * -> *). (forall a. f a) -> CommonAttributes r f
bpure ((a -> [Attribute action]) -> SvgF action a
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ((a -> [Attribute action]) -> SvgF action a)
-> (a -> [Attribute action]) -> SvgF action a
forall a b. (a -> b) -> a -> b
$ [Attribute action] -> a -> [Attribute action]
forall a b. a -> b -> a
const [])
  svgWriteAttrs :: CommonAttributes r Maybe -> [Attribute action]
svgWriteAttrs = (forall a. Const [Attribute action] a -> [Attribute action])
-> CommonAttributes r (Const [Attribute action])
-> [Attribute action]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap Const [Attribute action] a -> [Attribute action]
forall a. Const [Attribute action] a -> [Attribute action]
forall {k} a (b :: k). Const a b -> a
getConst
                (CommonAttributes r (Const [Attribute action])
 -> [Attribute action])
-> (CommonAttributes r Maybe
    -> CommonAttributes r (Const [Attribute action]))
-> CommonAttributes r Maybe
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. SvgF action a -> Maybe a -> Const [Attribute action] a)
-> CommonAttributes r (SvgF action)
-> CommonAttributes r Maybe
-> CommonAttributes r (Const [Attribute action])
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith SvgF action a -> Maybe a -> Const [Attribute action] a
forall a. SvgF action a -> Maybe a -> Const [Attribute action] a
forall action a.
SvgF action a -> Maybe a -> Const [Attribute action] a
writeAttr CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions

writeAttr :: forall action. (forall a. SvgF action a -> Maybe a -> Const [Attribute action] a)
writeAttr :: forall action a.
SvgF action a -> Maybe a -> Const [Attribute action] a
writeAttr (SvgF a -> [Attribute action]
attr) Maybe a
m = [Attribute action] -> Const [Attribute action] a
forall {k} a (b :: k). a -> Const a b
Const ([Attribute action] -> Const [Attribute action] a)
-> [Attribute action] -> Const [Attribute action] a
forall a b. (a -> b) -> a -> b
$ [Attribute action]
-> (a -> [Attribute action]) -> Maybe a -> [Attribute action]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> [Attribute action]
attr Maybe a
m


instance ToMisoString r => SvgWriteAttributes (SymbolAttributesF r) action where
  svgAttrFunctions :: SymbolAttributesF r (SvgF action)
svgAttrFunctions = SymbolAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke      = (IpeColor r -> [Attribute action]) -> SvgF action (IpeColor r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeColor r -> Attribute action)
-> IpeColor r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
stroke_ (MisoString -> Attribute action)
-> (IpeColor r -> MisoString) -> IpeColor r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _fill :: SvgF action (IpeColor r)
_fill        = (IpeColor r -> [Attribute action]) -> SvgF action (IpeColor r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeColor r -> Attribute action)
-> IpeColor r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_   (MisoString -> Attribute action)
-> (IpeColor r -> MisoString) -> IpeColor r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _pen :: SvgF action (IpePen r)
_pen         = (IpePen r -> [Attribute action]) -> SvgF action (IpePen r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpePen r -> [Attribute action]
forall a b. a -> b -> a
const []           )
    , _symbolSize :: SvgF action (IpeSize r)
_symbolSize  = (IpeSize r -> [Attribute action]) -> SvgF action (IpeSize r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpeSize r -> [Attribute action]
forall a b. a -> b -> a
const []           )
    }
  svgWriteAttrs :: SymbolAttributesF r Maybe -> [Attribute action]
svgWriteAttrs = (forall a. Const [Attribute action] a -> [Attribute action])
-> SymbolAttributesF r (Const [Attribute action])
-> [Attribute action]
forall {k} (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap Const [Attribute action] a -> [Attribute action]
forall a. Const [Attribute action] a -> [Attribute action]
forall {k} a (b :: k). Const a b -> a
getConst
                (SymbolAttributesF r (Const [Attribute action])
 -> [Attribute action])
-> (SymbolAttributesF r Maybe
    -> SymbolAttributesF r (Const [Attribute action]))
-> SymbolAttributesF r Maybe
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. SvgF action a -> Maybe a -> Const [Attribute action] a)
-> SymbolAttributesF r (SvgF action)
-> SymbolAttributesF r Maybe
-> SymbolAttributesF r (Const [Attribute action])
forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a) -> b f -> b g -> b h
bzipWith SvgF action a -> Maybe a -> Const [Attribute action] a
forall a. SvgF action a -> Maybe a -> Const [Attribute action] a
forall action a.
SvgF action a -> Maybe a -> Const [Attribute action] a
writeAttr SymbolAttributesF r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions

instance ToMisoString r => SvgWriteAttributes (PathAttributesF r) action where
  svgAttrFunctions :: PathAttributesF r (SvgF action)
svgAttrFunctions = PathAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke        = (IpeColor r -> [Attribute action]) -> SvgF action (IpeColor r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeColor r -> Attribute action)
-> IpeColor r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
stroke_ (MisoString -> Attribute action)
-> (IpeColor r -> MisoString) -> IpeColor r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _fill :: SvgF action (IpeColor r)
_fill          = (IpeColor r -> [Attribute action]) -> SvgF action (IpeColor r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeColor r -> Attribute action)
-> IpeColor r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
fill_ (MisoString -> Attribute action)
-> (IpeColor r -> MisoString) -> IpeColor r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _pen :: SvgF action (IpePen r)
_pen           = (IpePen r -> [Attribute action]) -> SvgF action (IpePen r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpePen r -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _dash :: SvgF action (IpeDash r)
_dash          = (IpeDash r -> [Attribute action]) -> SvgF action (IpeDash r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpeDash r -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _lineCap :: SvgF action Int
_lineCap       = (Int -> [Attribute action]) -> SvgF action Int
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (Int -> Attribute action) -> Int -> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
strokeLinecap_ (MisoString -> Attribute action)
-> (Int -> MisoString) -> Int -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _lineJoin :: SvgF action Int
_lineJoin      = (Int -> [Attribute action]) -> SvgF action Int
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> Int -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _fillRule :: SvgF action FillType
_fillRule      = (FillType -> [Attribute action]) -> SvgF action FillType
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> FillType -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _arrow :: SvgF action (IpeArrow r)
_arrow         = (IpeArrow r -> [Attribute action]) -> SvgF action (IpeArrow r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpeArrow r -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _rArrow :: SvgF action (IpeArrow r)
_rArrow        = (IpeArrow r -> [Attribute action]) -> SvgF action (IpeArrow r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpeArrow r -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _strokeOpacity :: SvgF action (IpeValue r)
_strokeOpacity = (IpeValue r -> [Attribute action]) -> SvgF action (IpeValue r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeValue r -> Attribute action)
-> IpeValue r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
strokeOpacity_ (MisoString -> Attribute action)
-> (IpeValue r -> MisoString) -> IpeValue r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _opacity :: SvgF action (IpeValue r)
_opacity       = (IpeValue r -> [Attribute action]) -> SvgF action (IpeValue r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeValue r -> Attribute action)
-> IpeValue r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
fillOpacity_ (MisoString -> Attribute action)
-> (IpeValue r -> MisoString) -> IpeValue r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _tiling :: SvgF action MisoString
_tiling        = (MisoString -> [Attribute action]) -> SvgF action MisoString
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> MisoString -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    , _gradient :: SvgF action MisoString
_gradient      = (MisoString -> [Attribute action]) -> SvgF action MisoString
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> MisoString -> [Attribute action]
forall a b. a -> b -> a
const []                           )
    }

instance SvgWriteAttributes (GroupAttributesF r) action where
  svgAttrFunctions :: GroupAttributesF r (SvgF action)
svgAttrFunctions = GroupAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _clip :: SvgF action (Path r)
_clip        = (Path r -> [Attribute action]) -> SvgF action (Path r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> Path r -> [Attribute action]
forall a b. a -> b -> a
const [])
    }

instance ToMisoString r => SvgWriteAttributes (TextAttributesF r) action where
  svgAttrFunctions :: TextAttributesF r (SvgF action)
svgAttrFunctions = TextAttributes
    { _commonAttrs :: CommonAttributes r (SvgF action)
_commonAttrs = CommonAttributes r (SvgF action)
forall (ats :: (* -> *) -> *) action.
SvgWriteAttributes ats action =>
ats (SvgF action)
svgAttrFunctions
    , _stroke :: SvgF action (IpeColor r)
_stroke      = (IpeColor r -> [Attribute action]) -> SvgF action (IpeColor r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeColor r -> Attribute action)
-> IpeColor r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
stroke_ (MisoString -> Attribute action)
-> (IpeColor r -> MisoString) -> IpeColor r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeColor r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _textSize :: SvgF action (IpeSize r)
_textSize    = (IpeSize r -> [Attribute action]) -> SvgF action (IpeSize r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> IpeSize r -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _opacity :: SvgF action (IpeValue r)
_opacity     = (IpeValue r -> [Attribute action]) -> SvgF action (IpeValue r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF (Attribute action -> [Attribute action]
forall a. a -> [a]
singleton (Attribute action -> [Attribute action])
-> (IpeValue r -> Attribute action)
-> IpeValue r
-> [Attribute action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Attribute action
forall action. MisoString -> Attribute action
strokeOpacity_ (MisoString -> Attribute action)
-> (IpeValue r -> MisoString) -> IpeValue r -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IpeValue r -> MisoString
forall str. ToMisoString str => str -> MisoString
ms)
    , _textWidth :: SvgF action (TextSizeUnit r)
_textWidth   = (TextSizeUnit r -> [Attribute action])
-> SvgF action (TextSizeUnit r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> TextSizeUnit r -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _textHeight :: SvgF action (TextSizeUnit r)
_textHeight  = (TextSizeUnit r -> [Attribute action])
-> SvgF action (TextSizeUnit r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> TextSizeUnit r -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _depth :: SvgF action (TextSizeUnit r)
_depth       = (TextSizeUnit r -> [Attribute action])
-> SvgF action (TextSizeUnit r)
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> TextSizeUnit r -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _hAlign :: SvgF action HorizontalAlignment
_hAlign      = (HorizontalAlignment -> [Attribute action])
-> SvgF action HorizontalAlignment
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> HorizontalAlignment -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _vAlign :: SvgF action VerticalAlignment
_vAlign      = (VerticalAlignment -> [Attribute action])
-> SvgF action VerticalAlignment
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> VerticalAlignment -> [Attribute action]
forall a b. a -> b -> a
const [])
    , _style :: SvgF action MisoString
_style       = (MisoString -> [Attribute action]) -> SvgF action MisoString
forall action val. (val -> [Attribute action]) -> SvgF action val
SvgF ([Attribute action] -> MisoString -> [Attribute action]
forall a b. a -> b -> a
const [])
    }