darcs - INblobs

1 module ContextMenu

2 ( canvas, edge, node, via ) where

4 import State

5 import Network

6 import Document

7 import NetworkControl

8 import SafetyNet

9 import CommonIO

10 import Math (DoublePoint)

11 import qualified PersistentDocument as PD

12 import Palette

13 import InfoKind

14 import Text.Parse

15 import INReduction

17 import Graphics.UI.WX

18 import Graphics.UI.WXCore(windowGetMousePosition)

20 -- | Context menu for empty area of canvas

21 canvas :: (InfoKind n g, Show g, Parse g) => Frame () -> State g n e -> IO ()

22 canvas theFrame state =

23 do{ contextMenu <- menuPane []

24 ; menuItem contextMenu

25 [ text := "Add node (shift-click)"

26 , on command := safetyNet theFrame $ addNodeItem theFrame state

27 ]

28 {-

29 ; menuItem contextMenu

30 [ text := "Edit global info"

31 , on command := safetyNet theFrame $ changeGlobalInfo theFrame state

32 ]

33 -}

35 ; pointWithinWindow <- windowGetMousePosition theFrame

36 ; menuPopup contextMenu pointWithinWindow theFrame

37 ; objectDelete contextMenu

38 }

40 addNodeItem :: (InfoKind n g) => Frame () -> State g n e -> IO ()

41 addNodeItem theFrame state =

42 do{ mousePoint <- windowGetMousePosition theFrame

43 ; ppi <- getScreenPPI

44 ; let doubleMousePoint = screenToLogicalPoint ppi mousePoint

45 ; createNode doubleMousePoint state

46 }

48 -- | Context menu for an edge

49 edge :: (InfoKind n g, InfoKind e g) =>

50 Frame () -> DoublePoint -> State g n e -> Bool -> IO ()

51 edge theFrame mousepoint state isActivepair =

52 do{ contextMenu <- menuPane []

53 ; menuItem contextMenu

54 [ text := "Add control point"

55 , on command := safetyNet theFrame $ createVia mousepoint state

56 ]

57 ; menuItem contextMenu

58 [ text := "Delete edge (Del)"

59 , on command := safetyNet theFrame $ deleteSelection state

60 ]

61 {-

62 ; menuItem contextMenu

63 [ text := "Edit info (i)"

64 , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state

65 ]

66 -}

67 ; menuItem contextMenu

68 [ text := "Reduce active pair"

69 , enabled := isActivepair

70 , on command := reduce state

71 ]

72 ; pointWithinWindow <- windowGetMousePosition theFrame

73 ; menuPopup contextMenu pointWithinWindow theFrame

74 ; objectDelete contextMenu

75 }

77 -- | Context menu for a 'via' point

78 via :: Frame () -> State g n e -> IO ()

79 via theFrame state =

80 do{ contextMenu <- menuPane []

81 ; menuItem contextMenu

82 [ text := "Delete control point (Del)"

83 , on command := safetyNet theFrame $ deleteSelection state

84 ]

85 ; pointWithinWindow <- windowGetMousePosition theFrame

86 ; menuPopup contextMenu pointWithinWindow theFrame

87 ; objectDelete contextMenu

88 }

90 -- | Context menu for a node

91 node :: (InfoKind n g, InfoKind e g) => Int -> Frame () -> State g n e -> IO ()

92 node nodeNr theFrame state =

93 do{ contextMenu <- menuPane []

95 ; pDoc <- getDocument state

96 ; doc <- PD.getDocument pDoc

97 ; canvas <- getActiveCanvas state

98 ; let network = selectNetwork doc canvas

99 theNode = getNode nodeNr network

100 labelAbove = getNameAbove theNode

101 palette = getPalette doc

102 theShape = getShape theNode

103

104 ; aboveItem <- menuRadioItem contextMenu

105 [ text := "Label above (up arrow)"

106 , checked := labelAbove

107 , on command := safetyNet theFrame $ changeNamePosition True state

108 ]

109 ; belowItem <- menuRadioItem contextMenu

110 [ text := "Label below (down arrow)"

111 , checked := not labelAbove

112 , on command := safetyNet theFrame $ changeNamePosition False state

113 ]

114 -- ; set (if labelAbove then aboveItem else belowItem) [ checked := True ]

115 ; menuItem contextMenu

116 [ text := "Rename (r)"

117 , on command := safetyNet theFrame $ renameNode theFrame state

118 ]

119 {-

120 ; menuItem contextMenu

121 [ text := "Edit info (i)"

122 , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state

123 ]

124 -}

125

126 ; menuLine contextMenu

127 -- ; mapM_ (shapeItem theShape contextMenu) (shapes palette)

128 -- ; menuLine contextMenu

129

130 ; menuItem contextMenu

131 [ text := "Delete (Del)"

132 , on command := safetyNet theFrame $ deleteSelection state

133 ]

134

135 ; pointWithinWindow <- windowGetMousePosition theFrame

136 ; menuPopup contextMenu pointWithinWindow theFrame

137 ; objectDelete contextMenu

138

139 }

140 where

141 shapeItem curShape contextMenu (name,(shape,ports,info)) =

142 menuRadioItem contextMenu

143 [ text := ("Shape: "++name)

144 , checked := case curShape of { Left n -> n==name; Right s -> False; }

145 , on command := safetyNet theFrame $ changeNodeShape name newinfo state

146 ]

147 where newinfo = maybe blank id info