{-# LANGUAGE ScopedTypeVariables #-}
module Data.PlaneGraph.Draw where

import           Data.Ext
import           Data.Geometry.Ipe
import           Data.Geometry.Properties
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Polygon
import           Data.Maybe (catMaybes)
import           Data.PlaneGraph
import qualified Data.Vector as V

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

-- | Draws a planegraph using Marks, LineSegments, and simple polygons for
-- vertices, edges, and faces, respectively. Uses the default IpeOuts to draw
-- these elements.
drawPlaneGraph :: forall s v e f r. IpeOut (PlaneGraph s v e f r) Group r
drawPlaneGraph :: IpeOut (PlaneGraph s v e f r) Group r
drawPlaneGraph = (Point 2 r -> v -> Maybe (IpeObject r))
-> (LineSegment 2 v r -> e -> Maybe (IpeObject r))
-> (SimplePolygon v r -> f -> Maybe (IpeObject r))
-> IpeOut (PlaneGraph s v e f r) Group r
forall k r v e f (s :: k).
(Point 2 r -> v -> Maybe (IpeObject r))
-> (LineSegment 2 v r -> e -> Maybe (IpeObject r))
-> (SimplePolygon v r -> f -> Maybe (IpeObject r))
-> IpeOut (PlaneGraph s v e f r) Group r
drawPlaneGraphWith Point 2 r -> v -> Maybe (IpeObject r)
forall g _x.
(HasDefaultIpeOut g, NumType g ~ r) =>
g -> _x -> Maybe (IpeObject r)
defIO' LineSegment 2 v r -> e -> Maybe (IpeObject r)
forall g _x.
(HasDefaultIpeOut g, NumType g ~ r) =>
g -> _x -> Maybe (IpeObject r)
defIO' SimplePolygon v r -> f -> Maybe (IpeObject r)
forall g _x.
(HasDefaultIpeOut g, NumType g ~ r) =>
g -> _x -> Maybe (IpeObject r)
defIO'
  where
    defIO'     :: (HasDefaultIpeOut g, NumType g ~ r) => g -> _x -> Maybe (IpeObject r)
    defIO' :: g -> _x -> Maybe (IpeObject r)
defIO' g
p _x
_ = IpeObject r -> Maybe (IpeObject r)
forall a. a -> Maybe a
Just (IpeObject r -> Maybe (IpeObject r))
-> ((DefaultIpeOut g r
     :+ Attributes' r (AttributesOf (DefaultIpeOut g)))
    -> IpeObject r)
-> (DefaultIpeOut g r
    :+ Attributes' r (AttributesOf (DefaultIpeOut g)))
-> Maybe (IpeObject r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefaultIpeOut g r
 :+ Attributes' r (AttributesOf (DefaultIpeOut g)))
-> IpeObject r
forall (i :: * -> *) r. ToObject i => IpeObject' i r -> IpeObject r
iO ((DefaultIpeOut g r
  :+ Attributes' r (AttributesOf (DefaultIpeOut g)))
 -> Maybe (IpeObject r))
-> (DefaultIpeOut g r
    :+ Attributes' r (AttributesOf (DefaultIpeOut g)))
-> Maybe (IpeObject r)
forall a b. (a -> b) -> a -> b
$ IpeOut g (DefaultIpeOut g) (NumType g)
forall g.
HasDefaultIpeOut g =>
IpeOut g (DefaultIpeOut g) (NumType g)
defIO g
p

-- | Draws a planegraph using Marks, LineSegments, and simple polygons for
-- vertices, edges, and faces, respectively.
drawPlaneGraphWith            :: (Point 2 r         -> v -> Maybe (IpeObject r))
                              -> (LineSegment 2 v r -> e -> Maybe (IpeObject r))
                              -> (SimplePolygon v r -> f -> Maybe (IpeObject r))
                              -> IpeOut (PlaneGraph s v e f r) Group r
drawPlaneGraphWith :: (Point 2 r -> v -> Maybe (IpeObject r))
-> (LineSegment 2 v r -> e -> Maybe (IpeObject r))
-> (SimplePolygon v r -> f -> Maybe (IpeObject r))
-> IpeOut (PlaneGraph s v e f r) Group r
drawPlaneGraphWith Point 2 r -> v -> Maybe (IpeObject r)
vF LineSegment 2 v r -> e -> Maybe (IpeObject r)
eF SimplePolygon v r -> f -> Maybe (IpeObject r)
fF PlaneGraph s v e f r
g = IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup IpeOut [IpeObject r] Group r -> IpeOut [IpeObject r] Group r
forall a b. (a -> b) -> a -> b
$ (Vector (Maybe (IpeObject r)) -> [IpeObject r])
-> [Vector (Maybe (IpeObject r))] -> [IpeObject r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Maybe (IpeObject r)] -> [IpeObject r]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (IpeObject r)] -> [IpeObject r])
-> (Vector (Maybe (IpeObject r)) -> [Maybe (IpeObject r)])
-> Vector (Maybe (IpeObject r))
-> [IpeObject r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Maybe (IpeObject r)) -> [Maybe (IpeObject r)]
forall a. Vector a -> [a]
V.toList) [Vector (Maybe (IpeObject r))
vs, Vector (Maybe (IpeObject r))
es, Vector (Maybe (IpeObject r))
fs]
  where
    vs :: Vector (Maybe (IpeObject r))
vs = (\(VertexId' s
_,VertexData Point 2 r
p v
v) -> Point 2 r -> v -> Maybe (IpeObject r)
vF Point 2 r
p v
v) ((VertexId' s, VertexData r v) -> Maybe (IpeObject r))
-> Vector (VertexId' s, VertexData r v)
-> Vector (Maybe (IpeObject r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (VertexId' s, VertexData r v)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (VertexId' s, VertexData r v)
vertices PlaneGraph s v e f r
g
    es :: Vector (Maybe (IpeObject r))
es = (\(Dart s
_,LineSegment 2 v r
s :+ e
e)         -> LineSegment 2 v r -> e -> Maybe (IpeObject r)
eF LineSegment 2 v r
s e
e) ((Dart s, LineSegment 2 v r :+ e) -> Maybe (IpeObject r))
-> Vector (Dart s, LineSegment 2 v r :+ e)
-> Vector (Maybe (IpeObject r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (Dart s, LineSegment 2 v r :+ e)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (Dart s, LineSegment 2 v r :+ e)
edgeSegments PlaneGraph s v e f r
g
    fs :: Vector (Maybe (IpeObject r))
fs = (\(FaceId' s
_,SimplePolygon v r
p :+ f
f)         -> SimplePolygon v r -> f -> Maybe (IpeObject r)
fF SimplePolygon v r
p f
f) ((FaceId' s, SimplePolygon v r :+ f) -> Maybe (IpeObject r))
-> Vector (FaceId' s, SimplePolygon v r :+ f)
-> Vector (Maybe (IpeObject r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (FaceId' s, SimplePolygon v r :+ f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (FaceId' s, SimplePolygon v r :+ f)
rawFacePolygons PlaneGraph s v e f r
g


-- | Draw a planegraph using the given functions. Fully generic in how we draw
-- the objects.
genericDrawPlaneGraphWith            :: (VertexId' s :+ v -> IpeObject r)
                                     -> (Dart s :+ e      -> IpeObject r)
                                     -> (FaceId' s :+ f   -> IpeObject r)
                                     -> IpeOut (PlaneGraph s v e f r) Group r
genericDrawPlaneGraphWith :: ((VertexId' s :+ v) -> IpeObject r)
-> ((Dart s :+ e) -> IpeObject r)
-> ((FaceId' s :+ f) -> IpeObject r)
-> IpeOut (PlaneGraph s v e f r) Group r
genericDrawPlaneGraphWith (VertexId' s :+ v) -> IpeObject r
vF (Dart s :+ e) -> IpeObject r
eF (FaceId' s :+ f) -> IpeObject r
fF PlaneGraph s v e f r
g = IpeOut [IpeObject r] Group r
forall (f :: * -> *) r.
Foldable f =>
IpeOut (f (IpeObject r)) Group r
ipeGroup IpeOut [IpeObject r] Group r -> IpeOut [IpeObject r] Group r
forall a b. (a -> b) -> a -> b
$ (Vector (IpeObject r) -> [IpeObject r])
-> [Vector (IpeObject r)] -> [IpeObject r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Vector (IpeObject r) -> [IpeObject r]
forall a. Vector a -> [a]
V.toList [Vector (IpeObject r)
vs, Vector (IpeObject r)
es, Vector (IpeObject r)
fs]
  where
    vs :: Vector (IpeObject r)
vs = (\(VertexId' s
v,VertexData Point 2 r
_ v
x) -> (VertexId' s :+ v) -> IpeObject r
vF ((VertexId' s :+ v) -> IpeObject r)
-> (VertexId' s :+ v) -> IpeObject r
forall a b. (a -> b) -> a -> b
$ VertexId' s
v VertexId' s -> v -> VertexId' s :+ v
forall core extra. core -> extra -> core :+ extra
:+ v
x) ((VertexId' s, VertexData r v) -> IpeObject r)
-> Vector (VertexId' s, VertexData r v) -> Vector (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (VertexId' s, VertexData r v)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (VertexId' s, VertexData r v)
vertices PlaneGraph s v e f r
g
    es :: Vector (IpeObject r)
es = ((Dart s :+ e) -> IpeObject r) -> (Dart s, e) -> IpeObject r
forall core extra t. ((core :+ extra) -> t) -> (core, extra) -> t
wrap (Dart s :+ e) -> IpeObject r
eF ((Dart s, e) -> IpeObject r)
-> Vector (Dart s, e) -> Vector (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (Dart s, e)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (Dart s, e)
edges PlaneGraph s v e f r
g
    fs :: Vector (IpeObject r)
fs = ((FaceId' s :+ f) -> IpeObject r) -> (FaceId' s, f) -> IpeObject r
forall core extra t. ((core :+ extra) -> t) -> (core, extra) -> t
wrap (FaceId' s :+ f) -> IpeObject r
fF ((FaceId' s, f) -> IpeObject r)
-> Vector (FaceId' s, f) -> Vector (IpeObject r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaneGraph s v e f r -> Vector (FaceId' s, f)
forall k (s :: k) v e f r.
PlaneGraph s v e f r -> Vector (FaceId' s, f)
faces PlaneGraph s v e f r
g

    wrap :: ((core :+ extra) -> t) -> (core, extra) -> t
wrap (core :+ extra) -> t
f (core
a,extra
b) = (core :+ extra) -> t
f ((core :+ extra) -> t) -> (core :+ extra) -> t
forall a b. (a -> b) -> a -> b
$ core
a core -> extra -> core :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
b