{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeFamilies, NoMonomorphismRestriction #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}
module Graph.SubGraphWindows (subgraphWindows, subgraphWithWindows, getColumns, getRows, ShowGraph, NestMap) where
import qualified Data.IntMap as I
import Data.List (groupBy, sortBy, (\\))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as VU
import Debug.Trace ( trace )
import Graph.CommonGraph
( CGraph, CGraphL, Column, YBlocks, YBlockLines, BoxId, Nesting, Border(..), LayerFeatures (..), NodeClass (dummyNode, isArgLabel, updateLayer), EdgeClass, UINode, X, Y,
bb, childrenSeparating, layer, lb, lbb, ltb, mid, myHead, nestingFeatures, parentsVertical, rb, rbb, rtb, tb, vHead
)
import Graph.IntMap (nodes)
import qualified Graph.IntMap as Graph
data Span = SpanLeftBorder | SpanMiddle | SpanRightBorder | SpanOutside deriving (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq,Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Span -> ShowS
showsPrec :: Int -> Span -> ShowS
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> ShowS
showList :: [Span] -> ShowS
Show)
data SpanInOut = Outside | Inside
type Min = Int
type Max = Int
type ShowGraph n e = (Enum n, Graph.ExtractNodeType n, Show n, Show e)
type NestMap = Map Nesting (Set BoxId)
type RowNodesPartOfBox = (X, [Bool])
subgraphWindows :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
(NestMap, [BoxId]) -> (CGraphL n e, [[UINode]]) -> [(Nesting, BoxId, (Min,Max), (Min,Max))]
subgraphWindows :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(NestMap, [UINode])
-> (CGraphL n e, [[UINode]])
-> [(Int, UINode, (Int, Int), (Int, Int))]
subgraphWindows (NestMap
nestedGraphs, [UINode]
boxIds) ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
| [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = []
| Bool
otherwise = [[(Int, UINode, (Int, Int), (Int, Int))]]
-> [(Int, UINode, (Int, Int), (Int, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, UINode, (Int, Int), (Int, Int))]]
boxes
where
ns :: [(Int, n)]
ns = IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (Graph n [e] -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
graph)
normPos :: Map UINode (Int, Int)
normPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
rows :: Map Y [UINode]
rows :: Map Int [UINode]
rows = CGraphL n e -> Map Int [UINode]
forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
graph, Map UINode (Int, Int)
normPos, YBlockLines
yblocks)
columns :: (Map Int [UINode], Map Int ([Column], YBlockLines))
columns = CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
graph, Map UINode (Int, Int)
normPos, YBlockLines
yblocks)
zRows :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
zRows :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [UINode]
rows)
zColumns :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList ((Map Int [UINode], Map Int ([Column], YBlockLines))
-> Map Int [UINode]
forall a b. (a, b) -> a
fst (Map Int [UINode], Map Int ([Column], YBlockLines))
columns))
spansZRows :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows :: Map Nesting [(BoxId, (Map X [(Min, Max)]))]
spansZColumns :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns :: Map Nesting [(BoxId, (Map X [(Min, Max)]))]
boxes :: [[(Int, UINode, (Int, Int), (Int, Int))]]
boxes = ((Int, [(UINode, Map Int [(Int, Int)])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
-> [(Int, UINode, (Int, Int), (Int, Int))])
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
-> [[(Int, UINode, (Int, Int), (Int, Int))]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, [(UINode, Map Int [(Int, Int)])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
-> [(Int, UINode, (Int, Int), (Int, Int))]
f (Map Int [(UINode, Map Int [(Int, Int)])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows) (Map Int [(UINode, Map Int [(Int, Int)])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns)
f :: (Nesting, [(BoxId, (Map X [(Min, Max)]))]) -> (Nesting, [(BoxId, (Map X [(Min, Max)]))]) -> [(Nesting, BoxId, (X,X), (Y,Y))]
f :: (Int, [(UINode, Map Int [(Int, Int)])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
-> [(Int, UINode, (Int, Int), (Int, Int))]
f (Int
nest0, [(UINode, Map Int [(Int, Int)])]
bs0) (Int
nest1, [(UINode, Map Int [(Int, Int)])]
bs1) = [(Int, UINode, (Int, Int), (Int, Int))]
bs
where bs :: [(Int, UINode, (Int, Int), (Int, Int))]
bs = ((UINode, Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> (Int, UINode, (Int, Int), (Int, Int)))
-> [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
-> [(Int, UINode, (Int, Int), (Int, Int))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (UINode, Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> (Int, UINode, (Int, Int), (Int, Int))
boxMinMax [(UINode, Map Int [(Int, Int)])]
bs0 [(UINode, Map Int [(Int, Int)])]
bs1
boxMinMax :: (UINode, Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> (Int, UINode, (Int, Int), (Int, Int))
boxMinMax (UINode
bid0, Map Int [(Int, Int)]
ms0) (UINode
bid1, Map Int [(Int, Int)]
ms1) = (Int
nest0, UINode
bid0, [(Int, Int)] -> (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> (a, b)
minmax (((Int, [(Int, Int)]) -> [(Int, Int)])
-> [(Int, [(Int, Int)])] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(Int, Int)]) -> [(Int, Int)]
forall a b. (a, b) -> b
snd (Map Int [(Int, Int)] -> [(Int, [(Int, Int)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(Int, Int)]
ms0)), [(Int, Int)] -> (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> (a, b)
minmax (((Int, [(Int, Int)]) -> [(Int, Int)])
-> [(Int, [(Int, Int)])] -> [(Int, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(Int, Int)]) -> [(Int, Int)]
forall a b. (a, b) -> b
snd (Map Int [(Int, Int)] -> [(Int, [(Int, Int)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [(Int, Int)]
ms1)))
minmax :: [(a, b)] -> (a, b)
minmax [(a, b)]
mm = ([a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
mm),
[b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
mm))
subgraphWithWindows :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
(NestMap, [BoxId]) -> (CGraphL n e, [[UINode]]) -> (CGraphL n e, [[UINode]])
subgraphWithWindows :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(NestMap, [UINode])
-> (CGraphL n e, [[UINode]]) -> (CGraphL n e, [[UINode]])
subgraphWithWindows (NestMap
nestedGraphs, [UINode]
boxIds) ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
| [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = ((Graph n [e]
graph, Map UINode (Int, Int)
pos, YBlockLines
yblocks), [[UINode]]
layers)
| Bool
otherwise =
((Graph n [e]
newGraph, Map UINode (Int, Int)
normPos, YBlockLines
newYblocks), [[UINode]]
layers)
where
newGraph :: Graph n [e]
newGraph =
(Int -> n -> n) -> Graph n [e] -> Graph n [e]
forall el nl0 nl1.
EdgeAttribute el =>
(Int -> nl0 -> nl1) -> Graph nl0 el -> Graph nl1 el
Graph.mapNodeWithKey
Int -> n -> n
forall n. (NodeClass n, Show n) => Int -> n -> n
changeNode
Graph n [e]
filledGraph
normPos :: Map UINode (Int, Int)
normPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
origPos :: Map UINode (Int, Int)
origPos = Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
originalPos (Graph n [e]
graph, Map UINode (Int, Int)
pos))
newYblocks :: YBlockLines
newYblocks = Map Int [[(UINode, Int)]] -> YBlockLines
forall k a. Map k a -> [(k, a)]
Map.toList (([[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]])
-> Map Int [[(UINode, Int)]]
-> Map Int [[(UINode, Int)]]
-> Map Int [[(UINode, Int)]]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
f (YBlockLines -> Map Int [[(UINode, Int)]]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList YBlockLines
yblocks) (YBlockLines -> Map Int [[(UINode, Int)]]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (([[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]]))
-> [[[(UINode, (Int, Int))]]] -> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map [[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]])
extractY [[[(UINode, (Int, Int))]]]
yblocksWithHorBorders)))
f :: [[(UINode, X)]] -> [[(UINode, X)]] -> [[(UINode, X)]]
f :: [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
f [[(UINode, Int)]]
blocks0 [[(UINode, Int)]]
blocks1 = ([(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]])
-> [[(UINode, Int)]] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
integrate [[(UINode, Int)]]
blocks1 [[(UINode, Int)]]
blocks0
where integrate :: [(UINode, X)] -> [[(UINode, X)]] -> [[(UINode, X)]]
integrate :: [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
integrate [(UINode, Int)]
b0 [[(UINode, Int)]]
blocks | ([(UINode, Int)] -> Bool) -> [[(UINode, Int)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([(UINode, Int)] -> [(UINode, Int)] -> Bool
oneNodePartOf [(UINode, Int)]
b0) [[(UINode, Int)]]
blocks = [[(UINode, Int)]]
blocks
| Bool
otherwise = [(UINode, Int)]
b0 [(UINode, Int)] -> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a. a -> [a] -> [a]
: [[(UINode, Int)]]
blocks
oneNodePartOf :: [(UINode, X)] -> [(UINode, X)] -> Bool
oneNodePartOf :: [(UINode, Int)] -> [(UINode, Int)] -> Bool
oneNodePartOf [(UINode, Int)]
block0 [(UINode, Int)]
block1 = (UINode -> Bool) -> [UINode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (UINode -> [UINode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UINode]
nb1) [UINode]
nb0
where nb0 :: [UINode]
nb0 = ((UINode, Int) -> UINode) -> [(UINode, Int)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> UINode
forall a b. (a, b) -> a
fst [(UINode, Int)]
block0
nb1 :: [UINode]
nb1 = ((UINode, Int) -> UINode) -> [(UINode, Int)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> UINode
forall a b. (a, b) -> a
fst [(UINode, Int)]
block1
extractY :: [[(UINode, (X,Y))]] -> (Y, [[(UINode, X)]])
extractY :: [[(UINode, (Int, Int))]] -> (Int, [[(UINode, Int)]])
extractY [[(UINode, (Int, Int))]]
ls = ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((UINode, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd ([(UINode, (Int, Int))] -> (UINode, (Int, Int))
forall a. HasCallStack => [a] -> a
head ([[(UINode, (Int, Int))]] -> [(UINode, (Int, Int))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(UINode, (Int, Int))]]
ls))), ([(UINode, (Int, Int))] -> [(UINode, Int)])
-> [[(UINode, (Int, Int))]] -> [[(UINode, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map (((UINode, (Int, Int)) -> (UINode, Int))
-> [(UINode, (Int, Int))] -> [(UINode, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, (Int, Int)) -> (UINode, Int)
forall {a} {b} {b}. (a, (b, b)) -> (a, b)
dropY ) [[(UINode, (Int, Int))]]
ls) where dropY :: (a, (b, b)) -> (a, b)
dropY (a
n, (b
x,b
y)) = (a
n,b
x)
yblocksWithHorBorders :: [[[(UINode, (X,Y))]]]
yblocksWithHorBorders :: [[[(UINode, (Int, Int))]]]
yblocksWithHorBorders = (([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> [[(UINode, (Int, Int))]] -> [[[(UINode, (Int, Int))]]]
forall a b. (a -> b) -> [a] -> [b]
map ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuousRow ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> ([(UINode, (Int, Int))] -> [(UINode, (Int, Int))])
-> [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering)
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering
forall {a} {a} {b} {a} {b}.
Ord a =>
(a, (a, b)) -> (a, (a, b)) -> Ordering
sortx) ([[(UINode, (Int, Int))]] -> [[[(UINode, (Int, Int))]]])
-> ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> [(UINode, (Int, Int))]
-> [[[(UINode, (Int, Int))]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Bool)
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Bool
forall {a} {a} {a} {a} {a}.
Eq a =>
(a, (a, a)) -> (a, (a, a)) -> Bool
groupy ([(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]])
-> ([(UINode, (Int, Int))] -> [(UINode, (Int, Int))])
-> [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering)
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (UINode, (Int, Int)) -> (UINode, (Int, Int)) -> Ordering
forall {a} {a} {a} {a} {a}.
Ord a =>
(a, (a, a)) -> (a, (a, a)) -> Ordering
sorty) [(UINode, (Int, Int))]
newBlockNodes
continuousRow :: [(UINode, (X, Y))] -> [[(UINode, (X,Y))]]
continuousRow :: [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuousRow [(UINode, (Int, Int))]
row = [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [[(UINode, (Int, Int))] -> (UINode, (Int, Int))
forall a. HasCallStack => [a] -> a
head [(UINode, (Int, Int))]
row] [(UINode, (Int, Int))]
row
groupy :: (a, (a, a)) -> (a, (a, a)) -> Bool
groupy (a
_,(a
x0,a
y0)) (a
_,(a
x1,a
y1)) = a
y0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y1
sortx :: (a, (a, b)) -> (a, (a, b)) -> Ordering
sortx (a
_,(a
x0,b
y0)) (a
_,(a
x1,b
y1)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x0 a
x1
sorty :: (a, (a, a)) -> (a, (a, a)) -> Ordering
sorty (a
_,(a
x0,a
y0)) (a
_,(a
x1,a
y1)) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
y0 a
y1
continuous :: [(UINode, (X,Y))] -> [(UINode, (X,Y))] -> [[(UINode, (X,Y))]]
continuous :: [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [(UINode, (Int, Int))]
cblock (b0 :: (UINode, (Int, Int))
b0@(UINode
n0,(Int
x0,Int
y0)) : b1 :: (UINode, (Int, Int))
b1@(UINode
n1,(Int
x1,Int
y1)) : [(UINode, (Int, Int))]
rest)
| Int
x0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 = [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous ([(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(UINode, (Int, Int))
b1]) ((UINode, (Int, Int))
b1 (UINode, (Int, Int))
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. a -> [a] -> [a]
: [(UINode, (Int, Int))]
rest)
| Bool
otherwise = [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [[(UINode, (Int, Int))]] -> [[(UINode, (Int, Int))]]
forall a. a -> [a] -> [a]
: ([(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [[(UINode, (Int, Int))]]
continuous [(UINode, (Int, Int))
b1] ((UINode, (Int, Int))
b1 (UINode, (Int, Int))
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. a -> [a] -> [a]
: [(UINode, (Int, Int))]
rest))
continuous [(UINode, (Int, Int))]
cblock [b0 :: (UINode, (Int, Int))
b0@(UINode
n0,(Int
x0,Int
y0))] = [[(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. HasCallStack => [a] -> [a]
init [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
-> [(UINode, (Int, Int))] -> [(UINode, (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [(UINode, (Int, Int))
b0]]
continuous [(UINode, (Int, Int))]
cblock [(UINode, (Int, Int))]
_ = [[(UINode, (Int, Int))]
cblock]
newBlockNodes :: [(UINode, (X,Y))]
newBlockNodes :: [(UINode, (Int, Int))]
newBlockNodes = [UINode] -> [(Int, Int)] -> [(UINode, (Int, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip [UINode]
borders ([Maybe (Int, Int)] -> [(Int, Int)]
forall a. [Maybe a] -> [a]
catMaybes ((UINode -> Maybe (Int, Int)) -> [UINode] -> [Maybe (Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\UINode
n -> UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (UINode -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral UINode
n) Map UINode (Int, Int)
origPos) [UINode]
borders))
borders :: [UINode]
borders = ((Int, n) -> UINode) -> [(Int, n)] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UINode) -> ((Int, n) -> Int) -> (Int, n) -> UINode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, n) -> Int
forall a b. (a, b) -> a
fst)
(((Int, n) -> Bool) -> [(Int, n)] -> [(Int, n)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Maybe Border) -> Bool
isHorizontalBorder (Maybe (Maybe Border) -> Bool)
-> ((Int, n) -> Maybe (Maybe Border)) -> (Int, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayerFeatures -> Maybe Border)
-> Maybe LayerFeatures -> Maybe (Maybe Border)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LayerFeatures -> Maybe Border
border (Maybe LayerFeatures -> Maybe (Maybe Border))
-> ((Int, n) -> Maybe LayerFeatures)
-> (Int, n)
-> Maybe (Maybe Border)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures (n -> Maybe LayerFeatures)
-> ((Int, n) -> n) -> (Int, n) -> Maybe LayerFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, n) -> n
forall a b. (a, b) -> b
snd) (IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (Graph n [e] -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
newGraph)))
isHorizontalBorder :: Maybe (Maybe Border) -> Bool
isHorizontalBorder (Just (Just Border
TopBorder)) = Bool
True
isHorizontalBorder (Just (Just Border
LeftTopBorder)) = Bool
True
isHorizontalBorder (Just (Just Border
RightTopBorder)) = Bool
True
isHorizontalBorder (Just (Just Border
BottomBorder)) = Bool
True
isHorizontalBorder (Just (Just Border
LeftBottomBorder)) = Bool
True
isHorizontalBorder (Just (Just Border
RightBottomBorder)) = Bool
True
isHorizontalBorder Maybe (Maybe Border)
_ = Bool
False
changeNode :: (NodeClass n, Show n) => I.Key -> n -> n
changeNode :: forall n. (NodeClass n, Show n) => Int -> n -> n
changeNode Int
n n
node = Maybe LayerFeatures -> Int -> n -> n
forall n.
(NodeClass n, Show n) =>
Maybe LayerFeatures -> Int -> n -> n
changeLayer Maybe LayerFeatures
nf Int
n n
node
where nf :: Maybe LayerFeatures
nf = n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures n
node
changeLayer :: (NodeClass n, Show n) => Maybe LayerFeatures -> I.Key -> n -> n
changeLayer :: forall n.
(NodeClass n, Show n) =>
Maybe LayerFeatures -> Int -> n -> n
changeLayer Maybe LayerFeatures
Nothing Int
n n
node
| n -> Bool
forall n. NodeClass n => n -> Bool
isArgLabel n
node =
Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
| Bool
otherwise =
Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
defaultFeatures) n
node
where
l :: (Int, Maybe UINode, (Span, Span))
l = (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int, Int, Maybe UINode)
xy Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns
xy :: (Int, Int, Maybe UINode)
xy = (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode)
forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0, Maybe UINode
forall a. Maybe a
Nothing) (UINode
-> Map UINode (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)))
changeLayer Maybe LayerFeatures
nestingFeats Int
n n
node
| n -> Bool
forall n. NodeClass n => n -> Bool
isArgLabel n
node =
Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l (LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just ((Maybe LayerFeatures -> LayerFeatures
forall a. HasCallStack => Maybe a -> a
fromJust Maybe LayerFeatures
nestingFeats) {layer = sel1 l}))) n
node
| Bool
otherwise =
Maybe LayerFeatures -> n -> n
forall n. NodeClass n => Maybe LayerFeatures -> n -> n
updateLayer ((Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int, Maybe UINode, (Span, Span))
l Maybe LayerFeatures
nestingFeats) n
node
where
l :: (Int, Maybe UINode, (Span, Span))
l = (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int, Int, Maybe UINode)
xy Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns
sel1 :: (a, b, c) -> a
sel1 (a
x,b
y,c
z) = a
x
xy :: (Int, Int, Maybe UINode)
xy = (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode)
forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0, Maybe UINode
forall a. Maybe a
Nothing) (UINode
-> Map UINode (Int, Int, Maybe UINode)
-> Maybe (Int, Int, Maybe UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)))
rootOf :: EdgeClass e => CGraph n e -> UINode -> UINode
rootOf :: forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf CGraph n e
gr UINode
node
| Vector UINode -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector UINode
psVert = UINode
node
| Bool
otherwise = CGraph n e -> UINode -> UINode
forall e n. EdgeClass e => CGraph n e -> UINode -> UINode
rootOf CGraph n e
gr (Int -> Vector UINode -> UINode
forall a. Unbox a => Int -> Vector a -> a
vHead Int
0 Vector UINode
psVert)
where
psVert :: Vector UINode
psVert = CGraph n e -> UINode -> Vector UINode
forall e n. EdgeClass e => Graph n [e] -> UINode -> Vector UINode
parentsVertical CGraph n e
gr UINode
node
defaultFeatures :: Maybe LayerFeatures
defaultFeatures = LayerFeatures -> Maybe LayerFeatures
forall a. a -> Maybe a
Just (Int -> Maybe UINode -> Maybe Border -> LayerFeatures
LayerFeatures Int
0 Maybe UINode
forall a. Maybe a
Nothing Maybe Border
forall a. Maybe a
Nothing)
changeStyle :: (Nesting, Maybe BoxId, (Span, Span)) -> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle :: (Int, Maybe UINode, (Span, Span))
-> Maybe LayerFeatures -> Maybe LayerFeatures
changeStyle (Int
n, Maybe UINode
b, (Span
SpanLeftBorder, Span
SpanLeftBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
lbb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanLeftBorder, Span
SpanMiddle)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
bb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanLeftBorder, Span
SpanRightBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
rbb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanMiddle, Span
SpanLeftBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
lb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanMiddle, Span
SpanMiddle)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
mid
changeStyle (Int
n, Maybe UINode
b, (Span
SpanMiddle, Span
SpanRightBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
rb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanRightBorder, Span
SpanLeftBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
ltb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanRightBorder, Span
SpanMiddle)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
tb
changeStyle (Int
n, Maybe UINode
b, (Span
SpanRightBorder, Span
SpanRightBorder)) Maybe LayerFeatures
style
= Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace Maybe LayerFeatures
style Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
rtb
changeStyle (Int
_, Maybe UINode
_, (Span, Span)
_) Maybe LayerFeatures
style = Maybe LayerFeatures
style
maybeReplace :: Maybe LayerFeatures -> Nesting -> Maybe BoxId -> (Nesting -> Maybe BoxId -> Maybe LayerFeatures) -> Maybe LayerFeatures
maybeReplace :: Maybe LayerFeatures
-> Int
-> Maybe UINode
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Maybe LayerFeatures
maybeReplace (Just (LayerFeatures Int
0 Maybe UINode
Nothing Maybe Border
_)) Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
lf = Int -> Maybe UINode -> Maybe LayerFeatures
lf Int
n Maybe UINode
b
maybeReplace (Just (LayerFeatures Int
n Maybe UINode
b Maybe Border
_)) Int
_ Maybe UINode
_ Int -> Maybe UINode -> Maybe LayerFeatures
lf = Int -> Maybe UINode -> Maybe LayerFeatures
lf Int
n Maybe UINode
b
maybeReplace Maybe LayerFeatures
_ Int
n Maybe UINode
b Int -> Maybe UINode -> Maybe LayerFeatures
lf = String
-> (Int -> Maybe UINode -> Maybe LayerFeatures)
-> Int
-> Maybe UINode
-> Maybe LayerFeatures
forall a. String -> a -> a
Debug.Trace.trace String
"_" Int -> Maybe UINode -> Maybe LayerFeatures
lf Int
n Maybe UINode
b
filledGraph :: Graph n [e]
filledGraph = [(UINode, n)] -> Graph n [e] -> Graph n [e]
forall el nl.
EdgeAttribute el =>
[(UINode, nl)] -> Graph nl el -> Graph nl el
Graph.insertNodes (((Int, n) -> (UINode, n)) -> [(Int, n)] -> [(UINode, n)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, n) -> (UINode, n)
forall {a} {a} {b}. (Integral a, Num a) => (a, b) -> (a, b)
fr [(Int, n)]
newNodes) Graph n [e]
graph
fr :: (a, b) -> (a, b)
fr (a
n, b
nl) = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n, b
nl)
addBoxId :: UINode -> (Any, Any) -> (Any, Any, Maybe UINode)
addBoxId UINode
k (Any
x,Any
y) = (Any
x,Any
y, Maybe UINode
bid)
where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
lu :: Maybe n
lu = UINode -> Graph n [e] -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k Graph n [e]
graph
newNodes :: [(Int, n)]
newNodes = (Int -> (Int, Int, Maybe UINode) -> (Int, n))
-> [Int] -> [(Int, Int, Maybe UINode)] -> [(Int, n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, Int, Maybe UINode) -> (Int, n)
forall {b} {a} {p}. NodeClass b => a -> p -> (a, b)
dNode [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..] [(Int, Int, Maybe UINode)]
holes
newPos :: Map Integer (Int, Int, Maybe UINode)
newPos = [(Integer, (Int, Int, Maybe UINode))]
-> Map Integer (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Integer]
-> [(Int, Int, Maybe UINode)]
-> [(Integer, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)
dNode :: a -> p -> (a, b)
dNode a
n p
_ = (a
n, Int -> b
forall n. NodeClass n => Int -> n
dummyNode Int
1)
m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes Graph n [e]
graph)
| Bool
otherwise = Int
0
holes :: [(Int, Int, Maybe BoxId)]
holes :: [(Int, Int, Maybe UINode)]
holes = ((Int, Int) -> (Int, Int, Maybe UINode))
-> [(Int, Int)] -> [(Int, Int, Maybe UINode)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
x,Int
y,Maybe UINode
forall a. Maybe a
Nothing)) ([(Int
x, Int
y) | Int
x <- [Int
minX .. Int
maxX], Int
y <- [Int
minY .. Int
maxY]] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Int, Int)]
nodePositions)
nodePositions :: [(Int, Int)]
nodePositions = Map UINode (Int, Int) -> [(Int, Int)]
forall k a. Map k a -> [a]
Map.elems Map UINode (Int, Int)
pos
ns :: [(Int, n)]
ns = IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (Graph n [e] -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels Graph n [e]
graph)
minX :: Int
minX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
minY :: Int
minY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
maxX :: Int
maxX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
maxY :: Int
maxY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
rows :: Map Y [UINode]
rows :: Map Int [UINode]
rows = CGraphL n e -> Map Int [UINode]
forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
filledGraph, Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)), YBlockLines
yblocks)
columns :: (Map Int [UINode], Map Int ([Column], YBlockLines))
columns = CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
filledGraph, Map UINode (Int, Int, Maybe UINode) -> Map UINode (Int, Int)
forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip ((Graph n [e], Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (Graph n [e]
graph, Map UINode (Int, Int)
pos)), YBlockLines
yblocks)
maxZCoord :: Nesting
maxZCoord :: Int
maxZCoord | [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, n) -> Int) -> [(Int, n)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, n
nl) -> n -> Int
forall {n}. NodeClass n => n -> Int
zOfNode n
nl) [(Int, n)]
ns
zOfNode :: n -> Int
zOfNode n
nl = Int -> (LayerFeatures -> Int) -> Maybe LayerFeatures -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 LayerFeatures -> Int
layer (n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures n
nl)
spansZRows :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZRows =
[(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows
spansZColumns :: Map Int [(UINode, Map Int [(Int, Int)])]
spansZColumns = [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns
zRows :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
zRows :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zRows = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int [UINode]
rows)
zColumns :: [(Int, [(UINode, [RowNodesPartOfBox])])]
zColumns = Graph n [e]
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers Graph n [e]
graph NestMap
nestedGraphs (Map Int [UINode] -> [Column]
forall k a. Map k a -> [(k, a)]
Map.toList ((Map Int [UINode], Map Int ([Column], YBlockLines))
-> Map Int [UINode]
forall a b. (a, b) -> a
fst (Map Int [UINode], Map Int ([Column], YBlockLines))
columns))
highestLayer ::
(X, Y, Maybe BoxId) ->
Map Nesting [(BoxId, Map X [(Min, Max)])] ->
Map Nesting [(BoxId, Map X [(Min, Max)])] ->
(Nesting, Maybe BoxId, (Span, Span))
highestLayer :: (Int, Int, Maybe UINode)
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> (Int, Maybe UINode, (Span, Span))
highestLayer (Int
x, Int
y, Maybe UINode
bid) Map Int [(UINode, Map Int [(Int, Int)])]
hrows Map Int [(UINode, Map Int [(Int, Int)])]
cols =
Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow Int
maxZCoord
where
findFirstWindow :: Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow Int
0 = (Int
0, Maybe UINode
bid, (Span
SpanOutside, Span
SpanOutside))
findFirstWindow Int
z
| Span -> Span -> Bool
found Span
chead Span
rhead = (Int
z, Maybe UINode
bid, (Span
chead, Span
rhead))
| Bool
otherwise = Int -> (Int, Maybe UINode, (Span, Span))
findFirstWindow (Int
z Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
where
c :: [Span]
c = (Span -> Bool) -> [Span] -> [Span]
forall a. (a -> Bool) -> [a] -> [a]
filter (Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
/= Span
SpanOutside) (((UINode, Map Int [(Int, Int)]) -> Span)
-> [(UINode, Map Int [(Int, Int)])] -> [Span]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
True (Map Int [(Int, Int)] -> Span)
-> ((UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)]
forall a b. (a, b) -> b
snd) [(UINode, Map Int [(Int, Int)])]
layerCols)
r :: [Span]
r = (Span -> Bool) -> [Span] -> [Span]
forall a. (a -> Bool) -> [a] -> [a]
filter (Span -> Span -> Bool
forall a. Eq a => a -> a -> Bool
/= Span
SpanOutside) (((UINode, Map Int [(Int, Int)]) -> Span)
-> [(UINode, Map Int [(Int, Int)])] -> [Span]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
False (Map Int [(Int, Int)] -> Span)
-> ((UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)])
-> (UINode, Map Int [(Int, Int)])
-> Span
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode, Map Int [(Int, Int)]) -> Map Int [(Int, Int)]
forall a b. (a, b) -> b
snd) [(UINode, Map Int [(Int, Int)])]
layerRows)
chead :: Span
chead | [Span] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Span]
c = Span
SpanOutside
| Bool
otherwise = [Span] -> Span
forall a. HasCallStack => [a] -> a
head [Span]
c
rhead :: Span
rhead | [Span] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Span]
r = Span
SpanOutside
| Bool
otherwise = [Span] -> Span
forall a. HasCallStack => [a] -> a
head [Span]
r
layerCols :: [(UINode, Map Int [(Int, Int)])]
layerCols =
[(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
forall a. a -> Maybe a -> a
fromMaybe [] (Int
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int [(UINode, Map Int [(Int, Int)])]
cols)
layerRows :: [(UINode, Map Int [(Int, Int)])]
layerRows =
[(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
-> [(UINode, Map Int [(Int, Int)])]
forall a. a -> Maybe a -> a
fromMaybe [] (Int
-> Map Int [(UINode, Map Int [(Int, Int)])]
-> Maybe [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z Map Int [(UINode, Map Int [(Int, Int)])]
hrows)
found :: Span -> Span -> Bool
found Span
SpanOutside Span
_ = Bool
False
found Span
_ Span
SpanOutside = Bool
False
found Span
_ Span
_ = Bool
True
overlappedByNeighbouringSpans :: (X, Y) -> Bool -> Map X [(Min, Max)] -> Span
overlappedByNeighbouringSpans :: (Int, Int) -> Bool -> Map Int [(Int, Int)] -> Span
overlappedByNeighbouringSpans (Int
x, Int
y) Bool
isColumn Map Int [(Int, Int)]
nspans
| Bool
isColumn =
(Span -> ((Int, Int) -> Span) -> Maybe (Int, Int) -> Span
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionColumn ([(Int, Int)] -> Maybe (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax [(Int, Int)]
spansCol))
| Bool
otherwise =
Span -> ((Int, Int) -> Span) -> Maybe (Int, Int) -> Span
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Span
SpanOutside (Int, Int) -> Span
spanPositionRow ([(Int, Int)] -> Maybe (Int, Int)
forall {a} {b}. (Ord a, Ord b) => [(a, b)] -> Maybe (a, b)
minmax [(Int, Int)]
spansRow)
where
spanPositionColumn :: (Int, Int) -> Span
spanPositionColumn (Int
smin, Int
smax)
| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanRightBorder
| Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanLeftBorder
| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
smax = Span
SpanMiddle
| Bool
otherwise = Span
SpanOutside
spanPositionRow :: (Int, Int) -> Span
spanPositionRow (Int
smin, Int
smax)
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smin = Span
SpanLeftBorder
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
smax = Span
SpanRightBorder
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
smin Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
smax = Span
SpanMiddle
| Bool
otherwise = Span
SpanOutside
minmax :: [(a, b)] -> Maybe (a, b)
minmax [(a, b)]
xs
| [(a, b)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
xs = Maybe (a, b)
forall a. Maybe a
Nothing
| Bool
otherwise = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ([a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
xs), [b] -> b
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
xs))
goLeft :: Int -> [(Int, Int)]
goLeft Int
p
| Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = [(Int, Int)]
mm [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goLeft (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
| Bool
otherwise = [(Int, Int)]
mm
where
mm :: [(Int, Int)]
mm = [(Int, Int)] -> Maybe [(Int, Int)] -> [(Int, Int)]
forall a. a -> Maybe a -> a
fromMaybe [] (Int -> Map Int [(Int, Int)] -> Maybe [(Int, Int)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
p Map Int [(Int, Int)]
nspans)
goRight :: Int -> [(Int, Int)]
goRight Int
p
| Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map Int [(Int, Int)] -> Int
forall k a. Map k a -> Int
Map.size Map Int [(Int, Int)]
nspans = [(Int, Int)]
mm [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise = [(Int, Int)]
mm
where
mm :: [(Int, Int)]
mm = [(Int, Int)] -> Maybe [(Int, Int)] -> [(Int, Int)]
forall a. a -> Maybe a -> a
fromMaybe [] (Int -> Map Int [(Int, Int)] -> Maybe [(Int, Int)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
p Map Int [(Int, Int)]
nspans)
spansCol :: [(Int, Int)]
spansCol = Int -> [(Int, Int)]
goLeft Int
x [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
spansRow :: [(Int, Int)]
spansRow = Int -> [(Int, Int)]
goLeft Int
y [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ Int -> [(Int, Int)]
goRight (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
strip :: Map k (a, b, c) -> Map k (a, b)
strip :: forall k a b c. Map k (a, b, c) -> Map k (a, b)
strip Map k (a, b, c)
m = ((a, b, c) -> (a, b)) -> Map k (a, b, c) -> Map k (a, b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(a
x, b
y, c
bid) -> (a
x, b
y)) Map k (a, b, c)
m
originalPos :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
(CGraph n e, Map UINode (X, Y)) -> Map UINode (X, Y, Maybe BoxId)
originalPos :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
originalPos (CGraph n e
graph, Map UINode (Int, Int)
pos) = ((Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int
x, Int
y, Maybe UINode
bid) -> (Int
x, Int
y, Maybe UINode
bid)) (Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((UINode -> (Int, Int) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int) -> Map UINode (Int, Int, Maybe UINode)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId Map UINode (Int, Int)
pos) Map UINode (Int, Int, Maybe UINode)
newPos)
where
minX :: Int
minX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
minY :: Int
minY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
maxX :: Int
maxX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
maxY :: Int
maxY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
nodePositions :: [(Int, Int)]
nodePositions = Map UINode (Int, Int) -> [(Int, Int)]
forall k a. Map k a -> [a]
Map.elems Map UINode (Int, Int)
pos
addBoxId :: UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId UINode
k (Int
x,Int
y) = (Int
x,Int
y, Maybe UINode
bid)
where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k CGraph n e
graph
newPos :: Map UINode (Int, Int, Maybe UINode)
newPos = [(UINode, (Int, Int, Maybe UINode))]
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([UINode]
-> [(Int, Int, Maybe UINode)]
-> [(UINode, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)
m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (CGraph n e -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes CGraph n e
graph)
| Bool
otherwise = Int
0
holes :: [(Int, Int, Maybe BoxId)]
holes :: [(Int, Int, Maybe UINode)]
holes = ((Int, Int) -> (Int, Int, Maybe UINode))
-> [(Int, Int)] -> [(Int, Int, Maybe UINode)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
x,Int
y,Maybe UINode
forall a. Maybe a
Nothing)) ([(Int
x, Int
y) | Int
x <- [Int
minX .. Int
maxX], Int
y <- [Int
minY .. Int
maxY]] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Int, Int)]
nodePositions)
normalisedPos :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
(CGraph n e, Map UINode (X, Y)) -> Map UINode (X, Y, Maybe BoxId)
normalisedPos :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
(CGraph n e, Map UINode (Int, Int))
-> Map UINode (Int, Int, Maybe UINode)
normalisedPos (CGraph n e
graph, Map UINode (Int, Int)
pos) = ((Int, Int, Maybe UINode) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int
x, Int
y, Maybe UINode
bid) -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minX, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minY, Maybe UINode
bid)) (Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((UINode -> (Int, Int) -> (Int, Int, Maybe UINode))
-> Map UINode (Int, Int) -> Map UINode (Int, Int, Maybe UINode)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId Map UINode (Int, Int)
pos) Map UINode (Int, Int, Maybe UINode)
newPos)
where
minX :: Int
minX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
minY :: Int
minY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
maxX :: Int
maxX | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
nodePositions)
maxY :: Int
maxY | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd [(Int, Int)]
nodePositions)
nodePositions :: [(Int, Int)]
nodePositions = Map UINode (Int, Int) -> [(Int, Int)]
forall k a. Map k a -> [a]
Map.elems Map UINode (Int, Int)
pos
addBoxId :: UINode -> (Int, Int) -> (Int, Int, Maybe UINode)
addBoxId UINode
k (Int
x,Int
y) = (Int
x,Int
y, Maybe UINode
bid)
where bid :: Maybe UINode
bid = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
lf :: Maybe BoxId
lf :: Maybe LayerFeatures
lf = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu :: Maybe LayerFeatures
lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
k CGraph n e
graph
newPos :: Map UINode (Int, Int, Maybe UINode)
newPos = [(UINode, (Int, Int, Maybe UINode))]
-> Map UINode (Int, Int, Maybe UINode)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([UINode]
-> [(Int, Int, Maybe UINode)]
-> [(UINode, (Int, Int, Maybe UINode))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ..]) [(Int, Int, Maybe UINode)]
holes)
m :: Int
m | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
nodePositions = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (CGraph n e -> [Int]
forall {a} {el}. Graph a el -> [Int]
nodes CGraph n e
graph)
| Bool
otherwise = Int
0
holes :: [(Int, Int, Maybe BoxId)]
holes :: [(Int, Int, Maybe UINode)]
holes = ((Int, Int) -> (Int, Int, Maybe UINode))
-> [(Int, Int)] -> [(Int, Int, Maybe UINode)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y) -> (Int
x,Int
y,Maybe UINode
forall a. Maybe a
Nothing)) ([(Int
x, Int
y) | Int
x <- [Int
minX .. Int
maxX], Int
y <- [Int
minY .. Int
maxY]] [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Int, Int)]
nodePositions)
zLayers :: (NodeClass n, EdgeClass e, ShowGraph n e, VU.Unbox UINode) =>
CGraph n e -> NestMap -> [(X, [UINode])] -> [(Nesting, [(BoxId, [RowNodesPartOfBox])])]
zLayers :: forall n e.
(NodeClass n, EdgeClass e, ShowGraph n e, Unbox UINode) =>
CGraph n e
-> NestMap -> [Column] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
zLayers CGraph n e
graph NestMap
nestedGraphs [Column]
xs = (Int -> (Int, [(UINode, [RowNodesPartOfBox])]))
-> [Int] -> [(Int, [(UINode, [RowNodesPartOfBox])])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, [(UINode, [RowNodesPartOfBox])])
getLayer ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
1 .. Int
maxZCoord])
where
getLayer :: Nesting -> (Nesting, [(BoxId, [RowNodesPartOfBox])])
getLayer :: Int -> (Int, [(UINode, [RowNodesPartOfBox])])
getLayer Int
z =
(Int
z, [(UINode, [RowNodesPartOfBox])]
-> ([UINode] -> [(UINode, [RowNodesPartOfBox])])
-> Maybe [UINode]
-> [(UINode, [RowNodesPartOfBox])]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((UINode -> (UINode, [RowNodesPartOfBox]))
-> [UINode] -> [(UINode, [RowNodesPartOfBox])]
forall a b. (a -> b) -> [a] -> [b]
map UINode -> (UINode, [RowNodesPartOfBox])
nodesPartOfBox) Maybe [UINode]
boxesOfLayerZ)
where
boxesOfLayerZ :: Maybe [BoxId]
boxesOfLayerZ :: Maybe [UINode]
boxesOfLayerZ = (Set UINode -> [UINode]) -> Maybe (Set UINode) -> Maybe [UINode]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Set UINode -> [UINode]
forall a. Set a -> [a]
Set.toList (Int -> NestMap -> Maybe (Set UINode)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
z NestMap
nestedGraphs)
nodesPartOfBox :: BoxId -> (BoxId, [RowNodesPartOfBox])
nodesPartOfBox :: UINode -> (UINode, [RowNodesPartOfBox])
nodesPartOfBox UINode
bid = (UINode
bid, (Column -> RowNodesPartOfBox) -> [Column] -> [RowNodesPartOfBox]
forall a b. (a -> b) -> [a] -> [b]
map Column -> RowNodesPartOfBox
rowCol [Column]
xs)
where
rowCol :: (X, [UINode]) -> RowNodesPartOfBox
rowCol :: Column -> RowNodesPartOfBox
rowCol (Int
x, [UINode]
ns) =
(Int
x, (UINode -> Bool) -> [UINode] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map UINode -> Bool
zBoxId [UINode]
ns)
where
lu :: UINode -> (UINode, Maybe n)
lu UINode
n = (UINode
n, UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
n CGraph n e
graph)
zBoxId :: UINode -> Bool
zBoxId :: UINode -> Bool
zBoxId UINode
n =
Maybe UINode
boxIdOfNode Maybe UINode -> Maybe UINode -> Bool
forall a. Eq a => a -> a -> Bool
== UINode -> Maybe UINode
forall a. a -> Maybe a
Just UINode
bid
where
lu :: Maybe n
lu = UINode -> CGraph n e -> Maybe n
forall nl el.
(Show nl, EdgeAttribute el) =>
UINode -> Graph nl el -> Maybe nl
Graph.lookupNode UINode
n CGraph n e
graph
b :: Maybe LayerFeatures
b = Maybe LayerFeatures
-> (n -> Maybe LayerFeatures) -> Maybe n -> Maybe LayerFeatures
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe LayerFeatures
forall a. Maybe a
Nothing n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures Maybe n
lu
boxIdOfNode :: Maybe UINode
boxIdOfNode = Maybe UINode
-> (LayerFeatures -> Maybe UINode)
-> Maybe LayerFeatures
-> Maybe UINode
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe UINode
forall a. Maybe a
Nothing LayerFeatures -> Maybe UINode
boxId Maybe LayerFeatures
b
maxZCoord :: Nesting
maxZCoord :: Int
maxZCoord | [(Int, n)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, n)]
ns = Int
0
| Bool
otherwise = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, n) -> Int) -> [(Int, n)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, n
nl) -> n -> Int
forall {n}. NodeClass n => n -> Int
zOfNode n
nl) [(Int, n)]
ns
zOfNode :: n -> Int
zOfNode n
nl = Int -> (LayerFeatures -> Int) -> Maybe LayerFeatures -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 LayerFeatures -> Int
layer (n -> Maybe LayerFeatures
forall n. NodeClass n => n -> Maybe LayerFeatures
nestingFeatures n
nl)
ns :: [(Int, n)]
ns = IntMap n -> [(Int, n)]
forall a. IntMap a -> [(Int, a)]
I.toList (CGraph n e -> IntMap n
forall nl el. Graph nl el -> IntMap nl
Graph.nodeLabels CGraph n e
graph)
spans :: [(Nesting, [(BoxId, [RowNodesPartOfBox])])] -> Map Nesting [(BoxId, (Map X [(Min, Max)]))]
spans :: [(Int, [(UINode, [RowNodesPartOfBox])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
spans [(Int, [(UINode, [RowNodesPartOfBox])])]
ls = [(Int, [(UINode, Map Int [(Int, Int)])])]
-> Map Int [(UINode, Map Int [(Int, Int)])]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Int, [(UINode, [RowNodesPartOfBox])])
-> (Int, [(UINode, Map Int [(Int, Int)])]))
-> [(Int, [(UINode, [RowNodesPartOfBox])])]
-> [(Int, [(UINode, Map Int [(Int, Int)])])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(UINode, [RowNodesPartOfBox])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
zSpans [(Int, [(UINode, [RowNodesPartOfBox])])]
ls)
where
zSpans :: (Nesting, [(BoxId, [RowNodesPartOfBox])]) -> (Nesting, [(BoxId, Map X [(Min, Max)])])
zSpans :: (Int, [(UINode, [RowNodesPartOfBox])])
-> (Int, [(UINode, Map Int [(Int, Int)])])
zSpans (Int
z, [(UINode, [RowNodesPartOfBox])]
bs) = (Int
z, ((UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)]))
-> [(UINode, [RowNodesPartOfBox])]
-> [(UINode, Map Int [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)])
box [(UINode, [RowNodesPartOfBox])]
bs)
where
box :: (BoxId, [RowNodesPartOfBox]) -> (BoxId, Map X [(Min, Max)])
box :: (UINode, [RowNodesPartOfBox]) -> (UINode, Map Int [(Int, Int)])
box (UINode
b, [RowNodesPartOfBox]
rowNodes) = (UINode
b, [(Int, [(Int, Int)])] -> Map Int [(Int, Int)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((RowNodesPartOfBox -> (Int, [(Int, Int)]))
-> [RowNodesPartOfBox] -> [(Int, [(Int, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map RowNodesPartOfBox -> (Int, [(Int, Int)])
rowsColums [RowNodesPartOfBox]
rowNodes))
rowsColums :: (X, [Bool]) -> (X, [(Min, Max)])
rowsColums :: RowNodesPartOfBox -> (Int, [(Int, Int)])
rowsColums (Int
x, [Bool]
nodePartOfBox) =
(Int
x, ([(Int, Bool)] -> (Int, Int)) -> [[(Int, Bool)]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, Bool)] -> (Int, Int)
minmax [[(Int, Bool)]]
fbis)
where minmax :: [(Int, Bool)] -> (Min,Max)
minmax :: [(Int, Bool)] -> (Int, Int)
minmax [(Int, Bool)]
group = ((Int, Bool) -> Int
forall a b. (a, b) -> a
fst ([(Int, Bool)] -> (Int, Bool)
forall a. HasCallStack => [a] -> a
head [(Int, Bool)]
group), (Int, Bool) -> Int
forall a b. (a, b) -> a
fst ([(Int, Bool)] -> (Int, Bool)
forall a. HasCallStack => [a] -> a
last [(Int, Bool)]
group))
bis :: [[(Int, Bool)]]
bis :: [[(Int, Bool)]]
bis = ((Int, Bool) -> (Int, Bool) -> Bool)
-> [(Int, Bool)] -> [[(Int, Bool)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int, Bool) -> (Int, Bool) -> Bool
forall {a} {a} {a}. Eq a => (a, a) -> (a, a) -> Bool
sec ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Bool]
nodePartOfBox)
fbis :: [[(Int, Bool)]]
fbis :: [[(Int, Bool)]]
fbis = ([(Int, Bool)] -> Bool) -> [[(Int, Bool)]] -> [[(Int, Bool)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([(Int, Bool)] -> Bool) -> [(Int, Bool)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Bool)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (([(Int, Bool)] -> [(Int, Bool)])
-> [[(Int, Bool)]] -> [[(Int, Bool)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Bool) -> Bool) -> [(Int, Bool)] -> [(Int, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Bool) -> Bool
forall a b. (a, b) -> b
snd) [[(Int, Bool)]]
bis)
sec :: (a, a) -> (a, a) -> Bool
sec (a
_,a
a) (a
_,a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
getColumns :: EdgeClass e => CGraphL n e -> (Map X [UINode], Map.Map Int ([Column], YBlockLines))
getColumns :: forall e n.
EdgeClass e =>
CGraphL n e -> (Map Int [UINode], Map Int ([Column], YBlockLines))
getColumns (Graph n [e]
gr, Map UINode (Int, Int)
m, YBlockLines
yblocks) =
([Column] -> Map Int [UINode]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [Column]
cols, [(Int, ([Column], YBlockLines))] -> Map Int ([Column], YBlockLines)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int]
-> [([Column], YBlockLines)] -> [(Int, ([Column], YBlockLines))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([[Column]] -> [YBlockLines] -> [([Column], YBlockLines)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Column]]
tables [YBlockLines]
yblocksOfTablesAdj)))
where
srt :: [UINode] -> [[UINode]]
srt = ([UINode] -> [UINode]) -> [[UINode]] -> [[UINode]]
forall a b. (a -> b) -> [a] -> [b]
map ((UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sorty) ([[UINode]] -> [[UINode]])
-> ([UINode] -> [[UINode]]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Bool) -> [UINode] -> [[UINode]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy UINode -> UINode -> Bool
groupx ([UINode] -> [[UINode]])
-> ([UINode] -> [UINode]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sortx
cols :: [Column]
cols = ([UINode] -> Column) -> [[UINode]] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map [UINode] -> Column
tupleWithX ( [UINode] -> [[UINode]]
srt ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
Graph.nodes Graph n [e]
gr)) )
tupleWithX :: [UINode] -> (X, [UINode])
tupleWithX :: [UINode] -> Column
tupleWithX [UINode]
ls = (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> [UINode] -> UINode
forall a. Int -> [a] -> a
myHead Int
78 [UINode]
ls) Map UINode (Int, Int)
m), [UINode]
ls)
groupx :: UINode -> UINode -> Bool
groupx UINode
n0 UINode
n1 = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m)
sortx :: UINode -> UINode -> Ordering
sortx UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))
sorty :: UINode -> UINode -> Ordering
sorty UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))
tables :: [[Column]]
tables = [Column] -> [[Column]]
divideTables [Column]
cols
yblocksOfTablesAdj :: [YBlockLines]
yblocksOfTablesAdj = (YBlockLines -> YBlockLines) -> [YBlockLines] -> [YBlockLines]
forall a b. (a -> b) -> [a] -> [b]
map YBlockLines -> YBlockLines
adjustTable [YBlockLines]
yblocksOfTables
adjustTable :: YBlockLines -> YBlockLines
adjustTable :: YBlockLines -> YBlockLines
adjustTable YBlockLines
table = ((Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]]))
-> YBlockLines -> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]])
adjustLine YBlockLines
table
where adjustLine :: YBlocks -> YBlocks
adjustLine :: (Int, [[(UINode, Int)]]) -> (Int, [[(UINode, Int)]])
adjustLine (Int
y,[[(UINode, Int)]]
line) = (Int
y, ([(UINode, Int)] -> [(UINode, Int)])
-> [[(UINode, Int)]] -> [[(UINode, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map [(UINode, Int)] -> [(UINode, Int)]
forall {a}. [(a, Int)] -> [(a, Int)]
adjustBlock [[(UINode, Int)]]
line)
adjustBlock :: [(a, Int)] -> [(a, Int)]
adjustBlock [(a, Int)]
block = ((a, Int) -> (a, Int)) -> [(a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (a, Int) -> (a, Int)
forall {a}. (a, Int) -> (a, Int)
node [(a, Int)]
block
node :: (a, Int) -> (a, Int)
node (a
n,Int
x) = (a
n,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lowestX)
lowestX :: Int
lowestX = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (((UINode, Int) -> Int) -> [(UINode, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> Int
forall a b. (a, b) -> b
snd ([[(UINode, Int)]] -> [(UINode, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[(UINode, Int)]]] -> [[(UINode, Int)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[[(UINode, Int)]]]] -> [[[(UINode, Int)]]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((YBlockLines -> [[[(UINode, Int)]]])
-> [YBlockLines] -> [[[[(UINode, Int)]]]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, [[(UINode, Int)]]) -> [[(UINode, Int)]])
-> YBlockLines -> [[[(UINode, Int)]]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]]) -> [[(UINode, Int)]]
forall a b. (a, b) -> b
snd) [YBlockLines]
yblocksOfTables)))))
yblocksOfTables :: [YBlockLines]
yblocksOfTables :: [YBlockLines]
yblocksOfTables = (YBlockLines, [YBlockLines]) -> [YBlockLines]
forall a b. (a, b) -> b
snd (([Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines]))
-> (YBlockLines, [YBlockLines])
-> [[Column]]
-> (YBlockLines, [YBlockLines])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable (YBlockLines
yblocks,[]) [[Column]]
tables)
divideTables :: [Column] -> [[Column]]
divideTables :: [Column] -> [[Column]]
divideTables [] = []
divideTables [Column]
layers = [Column]
layersWithoutSep [Column] -> [[Column]] -> [[Column]]
forall a. a -> [a] -> [a]
: [Column] -> [[Column]]
divideTables [Column]
rest
where
([Column]
layersWithoutSep, [Column]
rest) = ([Column], [Column]) -> ([Column], [Column])
sumLayers ([], [Column]
layers)
sumLayers :: ([Column], [Column]) -> ([Column], [Column])
sumLayers :: ([Column], [Column]) -> ([Column], [Column])
sumLayers ([Column]
s, []) = ([Column]
s, [])
sumLayers ([Column]
s, Column
l : [Column]
ls)
| [UINode] -> Bool
containsSeparatingEdge (Column -> [UINode]
forall a b. (a, b) -> b
snd Column
l) = ([Column]
s [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column
l], [Column]
ls)
| Bool
otherwise = ([Column], [Column]) -> ([Column], [Column])
sumLayers ([Column]
s [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column
l], [Column]
ls)
containsSeparatingEdge :: [UINode] -> Bool
containsSeparatingEdge = (UINode -> Bool) -> [UINode] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any UINode -> Bool
cs
where cs :: UINode -> Bool
cs UINode
n = Vector UINode -> Int
forall a. Unbox a => Vector a -> Int
VU.length (Graph n [e] -> UINode -> Vector UINode
forall e n. EdgeClass e => Graph n [e] -> UINode -> Vector UINode
childrenSeparating Graph n [e]
gr UINode
n) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
blocksOfTable :: [Column] -> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable :: [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable [Column]
_ ([],[YBlockLines]
res) = ([],[YBlockLines]
res)
blocksOfTable [Column]
cols (YBlockLines
ybs, [YBlockLines]
res)
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Int, [[(UINode, Int)]]) -> Bool) -> YBlockLines -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ([[(UINode, Int)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[(UINode, Int)]] -> Bool)
-> ((Int, [[(UINode, Int)]]) -> [[(UINode, Int)]])
-> (Int, [[(UINode, Int)]])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[(UINode, Int)]]) -> [[(UINode, Int)]]
forall a b. (a, b) -> b
snd) YBlockLines
newYBlocks) = ([],[YBlockLines]
res)
| Bool
otherwise = [Column]
-> (YBlockLines, [YBlockLines]) -> (YBlockLines, [YBlockLines])
blocksOfTable [Column]
cols (YBlockLines
reducedYBlocks, YBlockLines
newYBlocks YBlockLines -> [YBlockLines] -> [YBlockLines]
forall a. a -> [a] -> [a]
: [YBlockLines]
res)
where
table :: Set UINode
table = [UINode] -> Set UINode
forall a. Ord a => [a] -> Set a
Set.fromList ((Column -> [UINode]) -> [Column] -> [UINode]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Column -> [UINode]
forall a b. (a, b) -> b
snd [Column]
cols)
(YBlockLines
reducedYBlocks, YBlockLines
newYBlocks) = ((((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]]))
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
-> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]])
forall a b. (a, b) -> a
fst [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub, (((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]]))
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
-> YBlockLines
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
-> (Int, [[(UINode, Int)]])
forall a b. (a, b) -> b
snd [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub)
where sub :: [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
sub = ((Int, [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]])))
-> YBlockLines
-> [((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addBlockRemoveBlock YBlockLines
ybs
addBlockRemoveBlock :: YBlocks -> (YBlocks,YBlocks)
addBlockRemoveBlock :: (Int, [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addBlockRemoveBlock (Int
y,[[(UINode, Int)]]
yb) = ([[(UINode, Int)]], [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addY (([(UINode, Int)] -> Bool)
-> [[(UINode, Int)]] -> ([[(UINode, Int)]], [[(UINode, Int)]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break [(UINode, Int)] -> Bool
f [[(UINode, Int)]]
yb)
where addY :: ([[(UINode, Int)]], [[(UINode, Int)]])
-> ((Int, [[(UINode, Int)]]), (Int, [[(UINode, Int)]]))
addY ([[(UINode, Int)]]
yb0,[[(UINode, Int)]]
yb1) = ((Int
y,[[(UINode, Int)]]
yb0),(Int
y,[[(UINode, Int)]]
yb1))
f :: [(UINode, X)] -> Bool
f :: [(UINode, Int)] -> Bool
f [(UINode, Int)]
block = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (((UINode, Int) -> Bool) -> [(UINode, Int)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (UINode, Int) -> Bool
el [(UINode, Int)]
block)
el :: (UINode, Int) -> Bool
el (UINode
n,Int
_) = UINode
n UINode -> Set UINode -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set UINode
table
getRows :: CGraphL n e -> Map Y [UINode]
getRows :: forall n e. CGraphL n e -> Map Int [UINode]
getRows (Graph n [e]
gr, Map UINode (Int, Int)
m, YBlockLines
_) =
[Column] -> Map Int [UINode]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Column] -> Map Int [UINode]) -> [Column] -> Map Int [UINode]
forall a b. (a -> b) -> a -> b
$
([UINode] -> Column) -> [[UINode]] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map [UINode] -> Column
tupleWithY ( [UINode] -> [[UINode]]
srt ((Int -> UINode) -> [Int] -> [UINode]
forall a b. (a -> b) -> [a] -> [b]
map Int -> UINode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Graph n [e] -> [Int]
forall {a} {el}. Graph a el -> [Int]
Graph.nodes Graph n [e]
gr)) )
where
srt :: [UINode] -> [[UINode]]
srt = ([UINode] -> [UINode]) -> [[UINode]] -> [[UINode]]
forall a b. (a -> b) -> [a] -> [b]
map ((UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sortx) ([[UINode]] -> [[UINode]])
-> ([UINode] -> [[UINode]]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Bool) -> [UINode] -> [[UINode]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy UINode -> UINode -> Bool
groupy ([UINode] -> [[UINode]])
-> ([UINode] -> [UINode]) -> [UINode] -> [[UINode]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UINode -> UINode -> Ordering) -> [UINode] -> [UINode]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy UINode -> UINode -> Ordering
sorty
tupleWithY :: [UINode] -> (Y, [UINode])
tupleWithY :: [UINode] -> Column
tupleWithY [UINode]
ls = (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int -> [UINode] -> UINode
forall a. Int -> [a] -> a
myHead Int
579 [UINode]
ls) Map UINode (Int, Int)
m), [UINode]
ls)
groupy :: UINode -> UINode -> Bool
groupy UINode
n0 UINode
n1 = Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m)
sortx :: UINode -> UINode -> Ordering
sortx UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> a
fst (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))
sorty :: UINode -> UINode -> Ordering
sorty UINode
n0 UINode
n1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n0 Map UINode (Int, Int)
m)) (Int -> ((Int, Int) -> Int) -> Maybe (Int, Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UINode -> Map UINode (Int, Int) -> Maybe (Int, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UINode
n1 Map UINode (Int, Int)
m))