mirror of
https://github.com/rgleichman/glance.git
synced 2024-11-25 21:43:03 +03:00
Use a Set to represent an edge.
This commit is contained in:
parent
70f34a3d86
commit
5361e033fc
@ -183,7 +183,7 @@ data Port = Port
|
|||||||
-- | The port number of the port in the node.
|
-- | The port number of the port in the node.
|
||||||
_pPort :: Int
|
_pPort :: Int
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
data Inputs = Inputs
|
data Inputs = Inputs
|
||||||
{ -- | Raw mouse x and y position in window coordinates.
|
{ -- | Raw mouse x and y position in window coordinates.
|
||||||
@ -203,8 +203,12 @@ data AppState = AppState
|
|||||||
_asMovingNode :: !(Maybe ElemId),
|
_asMovingNode :: !(Maybe ElemId),
|
||||||
-- TODO _asEdges is a set, so consider using a set data structure here.
|
-- TODO _asEdges is a set, so consider using a set data structure here.
|
||||||
|
|
||||||
-- | The connections between nodes. Currently the edges do not have a direction.
|
-- | The connections between nodes. Each edge is a set of at least
|
||||||
_asEdges :: ![(Port, Port)],
|
-- two ports that are connected.
|
||||||
|
_asEdges ::
|
||||||
|
!( Set.Set
|
||||||
|
(Set.Set Port) -- Each Set of Ports is a single "edge".
|
||||||
|
),
|
||||||
-- | Iff Just, an edge is currently being draw where the ElemId is
|
-- | Iff Just, an edge is currently being draw where the ElemId is
|
||||||
-- one end of the edge.
|
-- one end of the edge.
|
||||||
_asCurrentEdge :: !(Maybe Port),
|
_asCurrentEdge :: !(Maybe Port),
|
||||||
@ -351,7 +355,7 @@ emptyAppState :: AppState
|
|||||||
emptyAppState =
|
emptyAppState =
|
||||||
AppState
|
AppState
|
||||||
{ _asMovingNode = Nothing,
|
{ _asMovingNode = Nothing,
|
||||||
_asEdges = [],
|
_asEdges = mempty,
|
||||||
_asCurrentEdge = Nothing,
|
_asCurrentEdge = Nothing,
|
||||||
_asCurrentPort = Nothing,
|
_asCurrentPort = Nothing,
|
||||||
_asElements = mempty,
|
_asElements = mempty,
|
||||||
@ -441,8 +445,20 @@ drawCurrentEdge mousePosition AppState {_asCurrentEdge, _asElements, _asTransfor
|
|||||||
|
|
||||||
drawEdges :: AppState -> Render ()
|
drawEdges :: AppState -> Render ()
|
||||||
drawEdges AppState {_asEdges, _asElements, _asTransform} =
|
drawEdges AppState {_asEdges, _asElements, _asTransform} =
|
||||||
traverse_ drawEdge _asEdges
|
traverse_
|
||||||
|
drawEdge
|
||||||
|
(Set.toList _asEdges >>= allPairs)
|
||||||
where
|
where
|
||||||
|
-- TODO Replace with a minimum spanning tree.
|
||||||
|
-- For each edge, generate all pairs of ports
|
||||||
|
allPairs :: Set.Set Port -> [(Port, Port)]
|
||||||
|
allPairs portSet = do
|
||||||
|
let ports = Set.toList portSet
|
||||||
|
a <- ports
|
||||||
|
let portsMinusA = Set.toList (Set.delete a portSet)
|
||||||
|
b <- portsMinusA
|
||||||
|
[(a, b)]
|
||||||
|
|
||||||
drawEdge :: (Port, Port) -> Render ()
|
drawEdge :: (Port, Port) -> Render ()
|
||||||
drawEdge (from, to) = case (lookupFrom, lookupTo) of
|
drawEdge (from, to) = case (lookupFrom, lookupTo) of
|
||||||
(Just fromElem, Just toElem) ->
|
(Just fromElem, Just toElem) ->
|
||||||
@ -548,9 +564,13 @@ clickOnNodePrimaryAction
|
|||||||
Just edgePort ->
|
Just edgePort ->
|
||||||
oldState
|
oldState
|
||||||
{ _asEdges =
|
{ _asEdges =
|
||||||
( edgePort,
|
-- TODO May want to add one of the ports to the other's existing edge.
|
||||||
|
Set.insert
|
||||||
|
( Set.fromList
|
||||||
|
[ edgePort,
|
||||||
Port {_pNode = elemId, _pPort = port}
|
Port {_pNode = elemId, _pPort = port}
|
||||||
) :
|
]
|
||||||
|
)
|
||||||
_asEdges,
|
_asEdges,
|
||||||
_asCurrentEdge = Nothing
|
_asCurrentEdge = Nothing
|
||||||
}
|
}
|
||||||
@ -746,6 +766,7 @@ leftClickAction ::
|
|||||||
leftClickAction inputsRef stateRef mousePosition =
|
leftClickAction inputsRef stateRef mousePosition =
|
||||||
do
|
do
|
||||||
state <- readIORef stateRef
|
state <- readIORef stateRef
|
||||||
|
-- print (_asEdges state)
|
||||||
let mElem = findElementByPosition (_asElements state) mousePosition
|
let mElem = findElementByPosition (_asElements state) mousePosition
|
||||||
|
|
||||||
addClickEvent inputs@Inputs {_inEvents} =
|
addClickEvent inputs@Inputs {_inEvents} =
|
||||||
|
Loading…
Reference in New Issue
Block a user