INblobs-0.1.1: src/GUIEvents.hs
module GUIEvents where
import Data.List (nub,(\\))
import NetworkView(clickedNode, clickedNodePort, clickedEdge, clickedVia)
import NetworkControl
import State
import Ports
import Common
import CommonIO
import Document
import qualified ContextMenu
import qualified PersistentDocument as PD
import InfoKind
import Text.Parse
import INReduction
import INReductionStrategies
import Graphics.UI.WX
import Graphics.UI.WXCore
mouseDown :: (InfoKind n g, InfoKind e g, Show g, Parse g) =>
Bool -> Point -> Frame () -> State g n e -> IO ()
mouseDown leftButton mousePoint theFrame state =
do{ pDoc <- getDocument state
; canvas <- getActiveCanvas state
; doc <- PD.getDocument pDoc
; ppi <- getScreenPPI
; let network = selectNetwork doc canvas
doubleMousePoint = screenToLogicalPoint ppi mousePoint
; disableReduce state
; case clickedNodePort doubleMousePoint doc canvas of
Nothing ->
case clickedVia doubleMousePoint network of
Nothing ->
case clickedEdge doubleMousePoint network of
Nothing -> -- click in empty area
if leftButton then
pickupArea doubleMousePoint state
else ContextMenu.canvas theFrame state
Just edgeNr -> -- click over the edge edgeNr
do let toReduce = canvas == Net && isActivePair edgeNr (getPalette doc) network
when toReduce $
do button <- getReduceButton state
set button [enabled := True]
if leftButton then
selectEdge edgeNr state
else
do{ selectEdge edgeNr state
; ContextMenu.edge theFrame doubleMousePoint state toReduce
}
Just (edgeNr,viaNr) -> -- click over the via viaNr on edge edgeNr
if leftButton then
case getSelection doc of
MultipleSelection canv _ ns vs
| (edgeNr,viaNr) `elem` vs && canv == canvas ->
pickupMultiple ns vs doubleMousePoint state
_ -> pickupVia edgeNr viaNr doubleMousePoint state
else
do{ selectVia edgeNr viaNr state
; ContextMenu.via theFrame state
}
Just (nodeNr, mPort) -> -- click over node nodeNr and
-- if also click on a port of that node mPort will be
-- Just port or
-- Nothing if click over a node but none of its ports
if leftButton then
case getSelection doc of
MultipleSelection canv _ ns vs
| nodeNr `elem` ns && canv == canvas ->
pickupMultiple ns vs doubleMousePoint state
_ -> pickupNode nodeNr mPort doubleMousePoint state
else
do{ selectPort nodeNr mPort state
; ContextMenu.node nodeNr theFrame state
}
}
leftMouseDownWithShift :: (InfoKind n g, InfoKind e g) =>
Point -> State g n e -> IO ()
leftMouseDownWithShift mousePoint state =
do{ pDoc <- getDocument state
; canvas <- getActiveCanvas state
; doc <- PD.getDocument pDoc
; ppi <- getScreenPPI
; let network = selectNetwork doc canvas
doubleMousePoint = screenToLogicalPoint ppi mousePoint
; disableReduce state
; case clickedNodePort doubleMousePoint doc canvas of
Nothing ->
case clickedEdge doubleMousePoint network of
Nothing ->
-- shift click in empty area = create new node
createNode doubleMousePoint state -- change shape of new node
Just i ->
selectEdge i state -- shift click on edge = select
Just (j,mP) -> do -- shift click on node = create edge (if possible)
case (getSelection doc, mP, canvas) of
(NodeSelection canv i (Just p), Just p', canvas)
| canv==canvas -> createEdge i p j p' state
(NodeSelection (LHS rL) i (Just p), Just p', RHS rR)
| rL==rR && p == p' && isInterfacePort p
-> createMapping rL i j state
-- print ("CREATING MAP: ", rL, (i, mPL), (nNrR, mPR))
{-
(NodeSelection canv i Nothing, Nothing, canvas) | i /= j -- no edges from one node to it self
-> if hasPorts then logMessage "Only allow connections between ports." else ?? -- createEdge i j state
(NodeSelection canv i Nothing, Just p') -> logMessage "Repeat it selecting a source port."
(NodeSelection canv i (Just p),Nothing) -> logMessage "Select a destination port."
(NodeSelection canv i (Just p), Just p') | i /= j -> createEdgePorts i p j p' state
-}
_ -> selectPort j mP state
}
-- para mudar
leftMouseDownWithMeta :: (InfoKind n g, InfoKind e g) =>
Point -> State g n e -> IO ()
leftMouseDownWithMeta mousePoint state =
do{ pDoc <- getDocument state
; canvas <- getActiveCanvas state
; doc <- PD.getDocument pDoc
; ppi <- getScreenPPI
; let network = selectNetwork doc canvas
doubleMousePoint = screenToLogicalPoint ppi mousePoint
; disableReduce state
; case clickedNode doubleMousePoint doc canvas of
Just j -> do -- meta click on node = toggle whether node in selection
case getSelection doc of
NodeSelection _ i _ {-??-}
| i == j -> selectNothing state
| i /= j -> selectMultiple Nothing (nub [i,j]) [] state
ViaSelection _ e v -> selectMultiple Nothing [j] [(e,v)] state
MultipleSelection _ _ ns vs
| j `elem` ns -> selectMultiple Nothing (ns\\[j]) vs state
| otherwise -> selectMultiple Nothing (j:ns) vs state
_ -> selectNode j state
Nothing ->
case clickedVia doubleMousePoint network of
Just via@(e,v) -> -- meta click on via point = toggle inclusion
case getSelection doc of
NodeSelection _ i _ {-??-} -> selectMultiple Nothing [i] [(e,v)] state
ViaSelection _ e' v'
| e==e' && v==v' -> selectNothing state
| otherwise -> selectMultiple Nothing [] [via,(e',v')]
state
MultipleSelection _ _ ns vs
| via `elem` vs -> selectMultiple Nothing ns (vs\\[via])
state
| otherwise -> selectMultiple Nothing ns (via:vs) state
_ -> selectVia e v state
Nothing -> return ()
}
leftMouseDrag :: Point -> ScrolledWindow () -> State g n e -> IO ()
leftMouseDrag mousePoint _ state =
do{ dragging <- getDragging state
; ppi <- getScreenPPI
; ifJust dragging $ \_ ->
do{ pDoc <- getDocument state
; doc <- PD.getDocument pDoc
; canvas <- getActiveCanvas state
; let doubleMousePoint = screenToLogicalPoint ppi mousePoint
; case getSelection doc of
NodeSelection canv nodeNr _ | canv == canvas ->
dragNode nodeNr doubleMousePoint state
ViaSelection canv edgeNr viaNr | canv == canvas ->
dragVia edgeNr viaNr doubleMousePoint state
MultipleSelection canv Nothing ns vs | canv == canvas ->
dragMultiple ns vs doubleMousePoint state
MultipleSelection canv _ _ _ | canv == canvas ->
dragArea doubleMousePoint state
_ -> do selectNothing state
-- setDragging Nothing state
}
}
leftMouseUp :: Point -> State g n e -> IO ()
leftMouseUp mousePoint state =
do{ dragging <- getDragging state
; ppi <- getScreenPPI
; ifJust dragging $ \(hasMoved, offset) ->
do{ pDoc <- getDocument state
; doc <- PD.getDocument pDoc
; canvas <- getActiveCanvas state
; let doubleMousePoint = screenToLogicalPoint ppi mousePoint
; case getSelection doc of
NodeSelection canv nodeNr _ | canv == canvas ->
dropNode hasMoved nodeNr offset doubleMousePoint state
ViaSelection canv edgeNr viaNr | canv == canvas ->
dropVia hasMoved edgeNr viaNr offset doubleMousePoint state
MultipleSelection canv Nothing ns vs | canv == canvas ->
dropMultiple hasMoved ns vs offset doubleMousePoint state
MultipleSelection canv _ _ _ | canv == canvas->
dropArea offset doubleMousePoint state
_ -> do selectNothing state
-- setDragging Nothing state
-- return ()
}
}
deleteKey :: State g n e -> IO ()
deleteKey state =
do disableReduce state
deleteSelection state
backspaceKey :: State g n e -> IO ()
backspaceKey state =
do disableReduce state
deleteSelection state
f2Key :: Frame () -> State g n e -> IO () -- due for demolition
f2Key theFrame state =
do disableReduce state
renameNode theFrame state
pressRKey :: Frame () -> State g n e -> IO ()
pressRKey theFrame state =
do disableReduce state
renameNode theFrame state
pressIKey :: (InfoKind n g, InfoKind e g) => Frame () -> State g n e -> IO ()
pressIKey theFrame state =
do disableReduce state
reinfoNodeOrEdge theFrame state
upKey :: State g n e -> IO ()
upKey state =
do disableReduce state
changeNamePosition True state
downKey :: State g n e -> IO ()
downKey state =
do disableReduce state
changeNamePosition False state