Tue Sep 27 15:35:05 WEST 2005 Malcolm.Wallace@cs.york.ac.uk
* new info field on every node
Add a new polymorphic info field on every node of the graph. The class
InfoKind constrains the info type, and eventually (in module Main), the
type must be resolved to something concrete, for now just ().
Meanwhile, the info field can be displayed on the diagram (there is a
new View menu, controlling the value of DisplayOptions), and edited as
if it were text (parsed back via Read class).
{
hunk ./Makefile 23
- src/Shape.hs src/Palette.hs \
+ src/Shape.hs src/Palette.hs src/InfoKind.hs \
+ src/DisplayOptions.hs \
hunk ./Makefile 27
- lib/DData/Map.hs lib/DData/MultiSet.hs lib/DData/Queue.hs lib/DData/Scc.hs \
+ lib/DData/Map.hs lib/DData/MultiSet.hs \
+ lib/DData/Queue.hs lib/DData/Scc.hs \
hunk ./Makefile 90
+src/Main.o : src/InfoKind.hi
hunk ./Makefile 94
+src/State.o : src/DisplayOptions.hi
hunk ./Makefile 105
+src/GUIEvents.o : src/InfoKind.hi
hunk ./Makefile 123
+src/Network.o : src/InfoKind.hi
hunk ./Makefile 128
+src/Node.o : src/InfoKind.hi
hunk ./Makefile 133
+src/NetworkFile.o : src/InfoKind.hi
+src/NetworkFile.o : src/Shape.hi
+src/NetworkFile.o : src/Colors.hi
hunk ./Makefile 146
+src/NetworkUI.o : src/DisplayOptions.hi
+src/NetworkUI.o : src/InfoKind.hi
hunk ./Makefile 163
+src/NetworkView.o : src/InfoKind.hi
+src/NetworkView.o : src/DisplayOptions.hi
hunk ./Makefile 175
+src/NetworkControl.o : src/InfoKind.hi
hunk ./Makefile 188
+src/ContextMenu.o : src/InfoKind.hi
hunk ./Makefile 209
+src/InfoKind.o : src/InfoKind.hs
+src/DisplayOptions.o : src/DisplayOptions.hs
hunk ./simple.blobpalette 6
- , shapeRadius = 0.5 } )
+ , shapeRadius = 0.5 }
+ , Just () )
hunk ./simple.blobpalette 15
- , DoublePoint (-0.5) 0.5 ] } )
+ , DoublePoint (-0.5) 0.5 ] }
+ , Just () )
hunk ./simple.blobpalette 23
- , DoublePoint 0.0 0.5 ] } )
+ , DoublePoint 0.0 0.5 ] }
+ , Just () )
hunk ./simple.blobpalette 40
- ] } )
+ ] }
+ , Just () )
hunk ./src/CommonIO.hs 63
-myTextDialog :: Window a -> String -> String -> Bool -> IO (Maybe String)
-myTextDialog parentWindow dialogTitle initial selectAll =
+data TextCtrlSize = SingleLine | MultiLine
+
+myTextDialog :: Window a -> TextCtrlSize -> String -> String -> Bool
+ -> IO (Maybe String)
+myTextDialog parentWindow size dialogTitle initial selectAll =
hunk ./src/CommonIO.hs 69
- ; textInput <- textEntry d [ alignment := AlignLeft, text := initial]
+ ; textInput <- (case size of SingleLine -> textEntry;
+ MultiLine -> textCtrl)
+ d [ alignment := AlignLeft, text := initial ]
hunk ./src/ContextMenu.hs 14
+import InfoKind
hunk ./src/ContextMenu.hs 20
-canvas :: Frame () -> State -> IO ()
+canvas :: InfoKind a => Frame () -> State a -> IO ()
hunk ./src/ContextMenu.hs 33
-addNodeItem :: Frame () -> State -> IO ()
+addNodeItem :: InfoKind a => Frame () -> State a -> IO ()
hunk ./src/ContextMenu.hs 42
-edge :: Frame () -> DoublePoint -> State -> IO ()
+edge :: Frame () -> DoublePoint -> State a -> IO ()
hunk ./src/ContextMenu.hs 59
-via :: Frame () -> State -> IO ()
+via :: Frame () -> State a -> IO ()
hunk ./src/ContextMenu.hs 72
-node :: Int -> Frame () -> State -> IO ()
+node :: InfoKind a => Int -> Frame () -> State a -> IO ()
hunk ./src/ContextMenu.hs 92
- [ text := "Rename (F2)"
+ [ text := "Rename (r)"
hunk ./src/ContextMenu.hs 95
+ ; menuItem contextMenu
+ [ text := "Edit info (i)"
+ , on command := safetyNet theFrame $ reinfoNode theFrame state
+ ]
hunk ./src/ContextMenu.hs 116
- shapeItem contextMenu (name,shape) =
+ shapeItem contextMenu (name,shape,_) =
addfile ./src/DisplayOptions.hs
hunk ./src/DisplayOptions.hs 1
+module DisplayOptions where
+
+data ShowInfo = Label | Info | LabelAndInfo
+ deriving (Eq)
+
+data DisplayOptions = DP
+ { dpShowInfo :: ShowInfo
+ }
+
+standard :: DisplayOptions
+standard = DP Label
hunk ./src/Document.hs 24
-data Document = Document
- { docNetwork :: Network.Network String
+data Document a = Document
+ { docNetwork :: Network.Network a
hunk ./src/Document.hs 42
-empty :: Document
+empty :: Document a
hunk ./src/Document.hs 53
-getNetwork :: Document -> Network.Network String
-getSelection :: Document -> Selection
+getNetwork :: Document a -> Network.Network a
+getSelection :: Document a -> Selection
hunk ./src/Document.hs 65
-setNetwork :: Network.Network String -> Document -> Document
+setNetwork :: Network.Network a -> Document a -> Document a
hunk ./src/Document.hs 71
-setSelection :: Selection -> Document -> Document
+setSelection :: Selection -> Document a -> Document a
hunk ./src/Document.hs 74
-updateNetwork :: (Network.Network String -> Network.Network String) -> Document -> Document
+updateNetwork :: (Network.Network a -> Network.Network a)
+ -> Document a -> Document a
hunk ./src/Document.hs 80
-updateNetworkEx :: (Network.Network String -> (b, Network.Network String)) -> Document -> (b, Document)
+updateNetworkEx :: (Network.Network a -> (b, Network.Network a))
+ -> Document a -> (b, Document a)
hunk ./src/Document.hs 89
-unsafeSetNetwork :: Network.Network String -> Document -> Document
+unsafeSetNetwork :: Network.Network a -> Document a -> Document a
hunk ./src/GUIEvents.hs 11
+import InfoKind
hunk ./src/GUIEvents.hs 16
-mouseDown :: Bool -> Point -> Frame () -> State -> IO ()
+mouseDown :: InfoKind a => Bool -> Point -> Frame () -> State a -> IO ()
hunk ./src/GUIEvents.hs 54
-leftMouseDownWithShift :: Point -> State -> IO ()
+leftMouseDownWithShift :: InfoKind a => Point -> State a -> IO ()
hunk ./src/GUIEvents.hs 75
-leftMouseDrag :: Point -> ScrolledWindow () -> State -> IO ()
+leftMouseDrag :: Point -> ScrolledWindow () -> State a -> IO ()
hunk ./src/GUIEvents.hs 92
-leftMouseUp :: Point -> State -> IO ()
+leftMouseUp :: Point -> State a -> IO ()
hunk ./src/GUIEvents.hs 109
-deleteKey :: State -> IO ()
+deleteKey :: State a -> IO ()
hunk ./src/GUIEvents.hs 113
-backspaceKey :: State -> IO ()
+backspaceKey :: State a -> IO ()
hunk ./src/GUIEvents.hs 117
-f2Key :: Frame () -> State -> IO ()
+f2Key :: Frame () -> State a -> IO () -- due for demolition
hunk ./src/GUIEvents.hs 121
-upKey :: State -> IO ()
+pressRKey :: Frame () -> State a -> IO ()
+pressRKey theFrame state =
+ renameNode theFrame state
+
+pressIKey :: InfoKind a => Frame () -> State a -> IO ()
+pressIKey theFrame state =
+ reinfoNode theFrame state
+
+upKey :: State a -> IO ()
hunk ./src/GUIEvents.hs 133
-downKey :: State -> IO ()
+downKey :: State a -> IO ()
addfile ./src/InfoKind.hs
hunk ./src/InfoKind.hs 1
+module InfoKind where
+
+import Text.XML.HaXml.Haskell2XmlNew
+
+-- | The @InfoKind@ class is a predicate that ensures we can always create
+-- at least a blank (empty) information element, that we can read and
+-- write them to/from the user, and that there exists some method of
+-- determining the correctness of the value (completeness/consistency etc)
+
+class (Eq a, Read a, Show a, Haskell2XmlNew a) => InfoKind a where
+ blank :: a
+ parse :: String -> Either String a -- alternative to read?
+ splat :: Maybe a -> String -- alternative to show?
+ check :: Maybe a -> [String] -- returns warnings
+
+-- A basic instance representing "no info"
+instance InfoKind () where
+ blank = ()
+ check Nothing = ["Info field is missing"]
+ check (Just _) = []
+
+{-
+-- Possible instances for other simple types.
+instance InfoKind String where
+ blank = ""
+instance InfoKind Int where
+ blank = 0
+instance InfoKind Double where
+ blank = 0
+-}
+
+-- Example of an aggregated instance
+instance InfoKind a => InfoKind [a] where
+ blank = [blank]
hunk ./src/Main.hs 6
+import InfoKind
hunk ./src/Main.hs 11
- ; NetworkUI.create state
+ ; NetworkUI.create state (undefined::())
+ -- 2nd arg used only to monomorphise InfoKind field of State.
hunk ./src/Network.hs 5
- , NodeNr, EdgeNr, ViaNr, ZeroProb
+ , NodeNr, EdgeNr, ViaNr
hunk ./src/Network.hs 42
+import InfoKind
hunk ./src/Network.hs 70
--- | Initial value of elements of probability table
--- also used when tables are resized or cleared
-class ZeroProb a where
- zeroProb :: a
-
-instance ZeroProb String where
- zeroProb = "-"
-
-instance ZeroProb Int where
- zeroProb = (-1)
-
-instance ZeroProb Double where
- zeroProb = (-1.0)
-
hunk ./src/Network.hs 208
-addNode :: ZeroProb a
+addNode :: InfoKind a
hunk ./src/Network.hs 219
-addNodes :: ZeroProb a => Int -> Network a -> ([NodeNr], Network a)
+addNodes :: InfoKind a => Int -> Network a -> ([NodeNr], Network a)
hunk ./src/Network.hs 226
-addNodeEx :: ZeroProb a => String -> DoublePoint -> Network a
+addNodeEx :: InfoKind a => String -> DoublePoint -> Network a
hunk ./src/Network.hs 238
-addEdge :: ZeroProb a => NodeNr -> NodeNr -> Network a -> Network a
+addEdge :: NodeNr -> NodeNr -> Network a -> Network a
hunk ./src/Network.hs 251
-addEdges :: ZeroProb a => [(NodeNr,NodeNr)] -> Network a -> Network a
+addEdges :: [(NodeNr,NodeNr)] -> Network a -> Network a
hunk ./src/Network.hs 256
-newViaEdge :: ZeroProb a => EdgeNr -> ViaNr -> DoublePoint
+newViaEdge :: EdgeNr -> ViaNr -> DoublePoint
hunk ./src/Network.hs 267
-removeNode :: ZeroProb a => NodeNr -> Network a -> Network a
+removeNode :: NodeNr -> Network a -> Network a
hunk ./src/Network.hs 280
-removeEdge :: ZeroProb a => EdgeNr -> Network a -> Network a
+removeEdge :: EdgeNr -> Network a -> Network a
hunk ./src/Network.hs 285
-removeAllEdges :: ZeroProb a => Network a -> Network a
+removeAllEdges :: Network a -> Network a
hunk ./src/Network.hs 291
-removeVia :: ZeroProb a => EdgeNr -> ViaNr -> Network a -> Network a
+removeVia :: EdgeNr -> ViaNr -> Network a -> Network a
hunk ./src/NetworkControl.hs 10
- , renameNode
+ , renameNode, reinfoNode
hunk ./src/NetworkControl.hs 26
+import InfoKind
hunk ./src/NetworkControl.hs 31
-changeNamePosition :: Bool -> State -> IO ()
+changeNamePosition :: Bool -> State a -> IO ()
hunk ./src/NetworkControl.hs 46
-changeNodeShape :: Shape -> State -> IO ()
+changeNodeShape :: Shape -> State a -> IO ()
hunk ./src/NetworkControl.hs 61
-deleteSelection :: State -> IO ()
+deleteSelection :: State a -> IO ()
hunk ./src/NetworkControl.hs 90
-createNode :: DoublePoint -> State -> IO ()
+createNode :: InfoKind a => DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 102
-selectEdge :: Int -> State -> IO ()
+selectEdge :: Int -> State a -> IO ()
hunk ./src/NetworkControl.hs 109
-createEdge :: Int -> Int -> State -> IO ()
+createEdge :: Int -> Int -> State a -> IO ()
hunk ./src/NetworkControl.hs 119
-createVia :: DoublePoint -> State -> IO ()
+createVia :: DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 138
-selectVia :: Int -> Int -> State -> IO ()
+selectVia :: Int -> Int -> State a -> IO ()
hunk ./src/NetworkControl.hs 146
-pickupVia :: Int -> Int -> DoublePoint -> State -> IO ()
+pickupVia :: Int -> Int -> DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 156
-selectNode :: Int -> State -> IO ()
+selectNode :: Int -> State a -> IO ()
hunk ./src/NetworkControl.hs 163
-pickupNode :: Int -> DoublePoint -> State -> IO ()
+pickupNode :: Int -> DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 173
-dragNode :: Int -> DoublePoint -> ScrolledWindow () -> State -> IO ()
+dragNode :: Int -> DoublePoint -> ScrolledWindow () -> State a -> IO ()
hunk ./src/NetworkControl.hs 194
-dropNode :: Bool -> Int -> DoublePoint -> DoublePoint -> State -> IO ()
+dropNode :: Bool -> Int -> DoublePoint -> DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 208
-dragVia :: Int -> Int -> DoublePoint -> ScrolledWindow () -> State -> IO ()
+dragVia :: Int -> Int -> DoublePoint -> ScrolledWindow () -> State a -> IO ()
hunk ./src/NetworkControl.hs 228
-dropVia :: Bool -> Int -> Int -> DoublePoint -> DoublePoint -> State -> IO ()
+dropVia :: Bool -> Int -> Int -> DoublePoint -> DoublePoint -> State a -> IO ()
hunk ./src/NetworkControl.hs 242
-renameNode :: Frame () -> State -> IO ()
+renameNode :: Frame () -> State a -> IO ()
hunk ./src/NetworkControl.hs 250
- ; result <- myTextDialog theFrame "Rename node" oldName True
+ ; result <- myTextDialog theFrame SingleLine
+ "Rename node" oldName True
hunk ./src/NetworkControl.hs 261
- [_$_]
- [_$_]
+
+reinfoNode :: InfoKind a => Frame () -> State a -> IO ()
+reinfoNode theFrame state = [_$_]
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; let network = getNetwork doc
+ ; case getSelection doc of
+ NodeSelection nodeNr ->
+ do{ let oldInfo = Node.getInfo (getNode nodeNr network)
+ ; result <- myTextDialog theFrame MultiLine
+ "Edit node info" (show oldInfo) True
+ ; ifJust result $ \newInfo ->
+ case reads newInfo of
+ [(x,"")] ->
+ do{ PD.updateDocument "edit node info"
+ (updateNetwork [_$_]
+ (updateNode nodeNr (Node.setInfo x))) pDoc
+ ; repaintAll state
+ }
+ _ -> errorDialog theFrame "Edit warning"
+ ("Cannot parse entered text")
+ }
+ _ -> return ()
+ }
+
hunk ./src/NetworkUI.hs 6
-import NetworkView
hunk ./src/NetworkUI.hs 19
+import InfoKind
+import DisplayOptions
hunk ./src/NetworkUI.hs 33
-getConfig :: State -> IO Config
+getConfig :: State a -> IO Config
hunk ./src/NetworkUI.hs 48
-create :: State ->IO ()
-create state =
- do{ theFrame <- frame [ text := "Diagram editor" ]
+create :: InfoKind a => State a -> a -> IO ()
+create state _ =
+ do{ theFrame <- frame [ text := "Diagram editor"
+ , position := pt 200 20
+ , clientSize := sz 300 240 ]
hunk ./src/NetworkUI.hs 160
+ -- View menu
+ ; viewMenu <- menuPane [ text := "&View" ]
+ ; menuItem viewMenu
+ [ text := "Label only"
+ , on command := safetyNet theFrame $ do
+ { setDisplayOptions (DP Label) state
+ ; repaintAll state } ]
+ ; menuItem viewMenu
+ [ text := "Info only"
+ , on command := safetyNet theFrame $ do
+ { setDisplayOptions (DP Info) state
+ ; repaintAll state } ]
+ ; menuItem viewMenu
+ [ text := "Label + Info"
+ , on command := safetyNet theFrame $ do
+ { setDisplayOptions (DP LabelAndInfo) state
+ ; repaintAll state } ]
+
hunk ./src/NetworkUI.hs 196
- [ menuBar := [ fileMenu, editMenu ]
- , layout := minsize (sz 250 150) $ fill $ widget canvas
+ [ menuBar := [ fileMenu, editMenu, viewMenu ]
+ , layout := minsize (sz 300 240) $ fill $ widget canvas
hunk ./src/NetworkUI.hs 201
- ; set theFrame
- [ position := pt 200 20
- , clientSize := sz 300 240
- ]
+ -- ; set theFrame
+ -- [ position := pt 200 20
+ -- , clientSize := sz 300 240
+ -- ]
hunk ./src/NetworkUI.hs 207
-paintHandler :: State -> DC () -> IO ()
+paintHandler :: InfoKind a => State a -> DC () -> IO ()
hunk ./src/NetworkUI.hs 211
- ; drawCanvas doc dc
+ ; dp <- getDisplayOptions state
+ ; drawCanvas doc dc dp
hunk ./src/NetworkUI.hs 218
-mouseEvent :: EventMouse -> ScrolledWindow () -> Frame () -> State -> IO ()
+mouseEvent :: InfoKind a =>
+ EventMouse -> ScrolledWindow () -> Frame () -> State a -> IO ()
hunk ./src/NetworkUI.hs 233
-keyboardEvent :: Frame () -> State -> EventKey -> IO ()
+keyboardEvent :: InfoKind a => Frame () -> State a -> EventKey -> IO ()
hunk ./src/NetworkUI.hs 239
+ KeyChar 'r' -> pressRKey theFrame state
+ KeyChar 'i' -> pressIKey theFrame state
hunk ./src/NetworkUI.hs 245
-closeDocAndThen :: State -> IO () -> IO ()
+closeDocAndThen :: State a -> IO () -> IO ()
hunk ./src/NetworkUI.hs 252
-newItem :: State -> IO ()
+newItem :: State a -> IO ()
hunk ./src/NetworkUI.hs 260
-openItem :: Frame () -> State -> IO ()
+openItem :: InfoKind a => Frame () -> State a -> IO ()
hunk ./src/NetworkUI.hs 274
-openNetworkFile :: String -> State -> Maybe (Frame ()) -> IO ()
+openNetworkFile :: InfoKind a => String -> State a -> Maybe (Frame ()) -> IO ()
hunk ./src/NetworkUI.hs 328
-openPalette :: Frame () -> State -> IO ()
+openPalette :: InfoKind a => Frame () -> State a -> IO ()
hunk ./src/NetworkUI.hs 342
-openPaletteFile :: String -> State -> Maybe (Frame ()) -> IO ()
+openPaletteFile :: InfoKind a => String -> State a -> Maybe (Frame ()) -> IO ()
hunk ./src/NetworkUI.hs 359
-applyCanvasSize :: State -> IO ()
+applyCanvasSize :: State a -> IO ()
hunk ./src/NetworkUI.hs 371
-saveToDisk :: Frame () -> String -> Document.Document -> IO Bool
+saveToDisk :: InfoKind a => Frame () -> String -> Document.Document a -> IO Bool
hunk ./src/NetworkUI.hs 375
-exit :: State -> IO ()
+exit :: State a -> IO ()
hunk ./src/NetworkView.hs 23
+import DisplayOptions
+import InfoKind
hunk ./src/NetworkView.hs 30
-drawCanvas :: Document -> DC () -> IO ()
-drawCanvas doc dc =
+drawCanvas :: InfoKind a => Document a -> DC () -> DisplayOptions -> IO ()
+drawCanvas doc dc opt =
hunk ./src/NetworkView.hs 46
- ; catch (reallyDrawCanvas doc screenPPI dc)
+ ; catch (reallyDrawCanvas doc screenPPI dc opt)
hunk ./src/NetworkView.hs 50
-reallyDrawCanvas :: Document -> Size -> DC () -> IO ()
-reallyDrawCanvas doc ppi dc =
+reallyDrawCanvas :: InfoKind a
+ => Document a -> Size -> DC () -> DisplayOptions -> IO ()
+reallyDrawCanvas doc ppi dc opt =
hunk ./src/NetworkView.hs 85
+ -- draw label
+ ; when (dpShowInfo opt `elem` [Label,LabelAndInfo]) $
+ drawLabel above (Node.getName node) center
+ -- draw info
+ ; when (dpShowInfo opt `elem` [Info,LabelAndInfo]) $
+ drawLabel (not above) (show (Node.getInfo node)) center
+ }
+ where
+ node = getNode nodeNr network
+ above = Node.getNameAbove node
+ center = Node.getPosition node
+ shape = Node.getShape node
hunk ./src/NetworkView.hs 98
- -- draw label background
- ; (textWidth, textHeight) <- logicalGetTextExtent ppi dc nodeName
- ; let textY = if Node.getNameAbove node
+ drawLabel :: Bool -> String -> DoublePoint -> IO ()
+ drawLabel above text (DoublePoint x y) =
+ do{ -- draw background
+ (textWidth, textHeight) <- logicalGetTextExtent ppi dc text
+ ; let textY = if above
hunk ./src/NetworkView.hs 112
-
- -- draw label text
- ; logicalText ppi dc (DoublePoint textX textY) nodeName []
+ -- draw text
+ ; logicalText ppi dc (DoublePoint textX textY) text []
hunk ./src/NetworkView.hs 115
- where
- node = getNode nodeNr network
- center@(DoublePoint x y) = Node.getPosition node
- nodeName = Node.getName node
- shape = Node.getShape node
hunk ./src/NetworkView.hs 156
-clickedNode :: DoublePoint -> Document -> Maybe Int
+clickedNode :: DoublePoint -> Document a -> Maybe Int
hunk ./src/Node.hs 8
+ , getInfo, setInfo
hunk ./src/Node.hs 14
+import InfoKind
hunk ./src/Node.hs 24
-create :: String -> DoublePoint -> Bool -> Node a
+create :: InfoKind a => String -> DoublePoint -> Bool -> Node a
hunk ./src/Node.hs 32
+ , nodeInfo = blank
hunk ./src/Node.hs 47
-setPosition :: DoublePoint -> Node a -> Node a
-setPosition position node = node { nodePoint = position }
-
-setName :: String -> Node a -> Node a
-setName name node = node { nodeName = name }
+getInfo :: Node a -> a
+getInfo node = nodeInfo node
hunk ./src/Node.hs 53
+
+setName :: String -> Node a -> Node a
+setName name node = node { nodeName = name }
hunk ./src/Node.hs 59
+
+setPosition :: DoublePoint -> Node a -> Node a
+setPosition position node = node { nodePoint = position }
+
+setInfo :: a -> Node a -> Node a
+setInfo info node = node { nodeInfo = info }
hunk ./src/Palette.hs 6
-data Palette = Palette [(String,Shape)]
+data Palette a = Palette [ (String, Shape, Maybe a) ]
hunk ./src/Palette.hs 9
-shapes :: Palette -> [ (String,Shape) ]
+shapes :: Palette a -> [ (String,Shape,Maybe a) ]
hunk ./src/Palette.hs 12
-join :: Palette -> Palette -> Palette
+join :: Eq a => Palette a -> Palette a -> Palette a
hunk ./src/Palette.hs 15
-delete :: Palette -> Palette -> Palette
+delete :: Eq a => Palette a -> Palette a -> Palette a
hunk ./src/Palette.hs 18
-empty :: Palette -- cannot be completely empty, always one default shape
-empty = Palette [("circle", Shape.circle)]
+-- cannot be completely empty, always one default shape
+empty :: Palette a
+empty = Palette [("circle", Shape.circle, Nothing)]
hunk ./src/State.hs 12
+ , getDisplayOptions, setDisplayOptions
hunk ./src/State.hs 19
+import DisplayOptions
hunk ./src/State.hs 24
-type State = Var StateRecord
+type State a = Var (StateRecord a)
hunk ./src/State.hs 26
-data StateRecord = St
- { stDocument :: PD.PersistentDocument Document
+data StateRecord a = St
+ { stDocument :: PD.PersistentDocument (Document a)
hunk ./src/State.hs 32
- , stPalette :: Palette.Palette -- available node shapes
+ , stPalette :: Palette.Palette a -- available node shapes/types
+ , stDisplayOptions :: DisplayOptions
hunk ./src/State.hs 41
-empty :: IO State
+empty :: IO (State a)
hunk ./src/State.hs 52
+ , stDisplayOptions = DisplayOptions.standard
hunk ./src/State.hs 58
-getDocument :: State -> IO (PD.PersistentDocument Document)
+getDocument :: State a -> IO (PD.PersistentDocument (Document a))
hunk ./src/State.hs 61
-getDragging :: State -> IO (Maybe (Bool, DoublePoint))
+getDragging :: State a -> IO (Maybe (Bool, DoublePoint))
hunk ./src/State.hs 64
-getNetworkFrame :: State -> IO (Frame ())
+getNetworkFrame :: State a -> IO (Frame ())
hunk ./src/State.hs 67
-getCanvas :: State -> IO (ScrolledWindow ())
+getCanvas :: State a -> IO (ScrolledWindow ())
hunk ./src/State.hs 70
-getPageSetupDialog :: State -> IO (PageSetupDialog ())
+getPageSetupDialog :: State a -> IO (PageSetupDialog ())
hunk ./src/State.hs 73
-getPalette :: State -> IO Palette.Palette
+getPalette :: State a -> IO (Palette.Palette a)
hunk ./src/State.hs 76
+getDisplayOptions :: State a -> IO DisplayOptions
+getDisplayOptions = getFromState stDisplayOptions
+
hunk ./src/State.hs 81
-setDragging :: Maybe (Bool, DoublePoint) -> State -> IO ()
+setDragging :: Maybe (Bool, DoublePoint) -> State a -> IO ()
hunk ./src/State.hs 85
-setNetworkFrame :: Frame () -> State -> IO ()
+setNetworkFrame :: Frame () -> State a -> IO ()
hunk ./src/State.hs 89
-setCanvas :: ScrolledWindow () -> State -> IO ()
+setCanvas :: ScrolledWindow () -> State a -> IO ()
hunk ./src/State.hs 93
-setPageSetupDialog :: PageSetupDialog () -> State -> IO ()
+setPageSetupDialog :: PageSetupDialog () -> State a -> IO ()
hunk ./src/State.hs 97
-setPalette :: Palette.Palette -> State -> IO ()
+setPalette :: Palette.Palette a -> State a -> IO ()
hunk ./src/State.hs 101
+setDisplayOptions :: DisplayOptions -> State a -> IO ()
+setDisplayOptions dp stateRef =
+ varUpdate_ stateRef (\state -> state { stDisplayOptions = dp })
+
hunk ./src/State.hs 107
-getFromState :: (StateRecord -> a) -> State -> IO a
+getFromState :: (StateRecord b -> a) -> State b -> IO a
hunk ./src/StateUtil.hs 13
-repaintAll :: State -> IO ()
+repaintAll :: State a -> IO ()
hunk ./src/StateUtil.hs 19
-getNetworkName :: State -> IO String
+getNetworkName :: State a -> IO String
}