Fri Aug 19 14:56:24 WEST 2005 Malcolm.Wallace@cs.york.ac.uk
* Add a palette of shapes.
Add a new feature: a user-definable palette of shapes for nodes.
The palette is just a haskell value containing shapes, stored in a file
and loaded at runtime by a new 'Edit' menu item. A node is still always
created initially as a circle, but can be changed afterwards to another
shape by selecting from the palette revealed by the context menu on the
node.
{
hunk ./Makefile 23
- src/Shape.hs \
+ src/Shape.hs src/Palette.hs \
hunk ./Makefile 91
+src/State.o : src/Palette.hi
hunk ./Makefile 136
+src/NetworkUI.o : src/Palette.hi
hunk ./Makefile 151
+src/NetworkView.o : src/Shape.hi
hunk ./Makefile 162
+src/NetworkControl.o : src/Shape.hi
hunk ./Makefile 186
+src/Shape.o : src/Shape.hs
+src/Shape.o : src/Constants.hi
+src/Shape.o : src/Math.hi
+src/Shape.o : src/CommonIO.hi
+src/Palette.o : src/Palette.hs
+src/Palette.o : src/Shape.hi
hunk ./src/ContextMenu.hs 13
-import Shape
+import Palette
hunk ./src/ContextMenu.hs 96
- ; shape1 <- menuRadioItem contextMenu
- [ text := "Shape circle"
- , on command := safetyNet theFrame $ changeNodeShape Shape.circle state
- ]
- ; shape2 <- menuRadioItem contextMenu
- [ text := "Shape square"
- , on command := safetyNet theFrame $ changeNodeShape Shape.square state
- ]
+ ; palette <- getPalette state
+ ; mapM_ (shapeItem contextMenu) (shapes palette)
hunk ./src/ContextMenu.hs 110
+ where
+ shapeItem contextMenu (name,shape) =
+ menuRadioItem contextMenu
+ [ text := ("Shape: "++name)
+ , on command := safetyNet theFrame $ changeNodeShape shape state
+ ]
+
hunk ./src/NetworkUI.hs 19
+import Palette
hunk ./src/NetworkUI.hs 151
+ ; menuLine editMenu
+ ; menuItem editMenu
+ [ text := "Open shape palette..."
+ , on command := safetyNet theFrame $ openPalette theFrame state
+ ]
hunk ./src/NetworkUI.hs 302
+
+openPalette :: Frame () -> State -> IO ()
+openPalette theFrame state =
+ do{ mbfname <- fileOpenDialog
+ theFrame
+ False -- change current directory
+ True -- allowReadOnly
+ "Open File"
+ [ ("Shape palettes (.blobpalette)", ["*.blobpalette"]) ]
+ "" "" -- no default directory or filename
+ ; ifJust mbfname $ \fname -> openPaletteFile fname state (Just theFrame)
+ }
+
+-- Third argument: Nothing means exceptions are ignored (used in Configuration)
+-- Just f means exceptions are shown in a dialog on top of frame f
+openPaletteFile :: String -> State -> Maybe (Frame ()) -> IO ()
+openPaletteFile fname state exceptionsFrame =
+ flip catch
+ (\exc -> case exceptionsFrame of
+ Nothing -> return ()
+ Just f -> errorDialog f "Open shape palette"
+ ( "Error while opening '" ++ fname ++ "'. \n\n"
+ ++ "Reason: " ++ show exc)
+ ) $
+ do{ contents <- readFile fname
+ ; case reads contents of {
+ [] -> ioError (userError ("Cannot parse shape palette file: "++fname));
+ ((p,_):_) -> setPalette p state
+ }}
addfile ./src/Palette.hs
hunk ./src/Palette.hs 1
+module Palette where
+
+import List (nub, (\\))
+import Shape
+
+data Palette = Palette [(String,Shape)]
+ deriving (Eq, Show, Read)
+
+shapes :: Palette -> [ (String,Shape) ]
+shapes (Palette p) = p
+
+join :: Palette -> Palette -> Palette
+join (Palette p) (Palette q) = Palette (nub (p++q))
+
+delete :: Palette -> Palette -> Palette
+delete (Palette p) (Palette q) = Palette (p\\q)
+
+empty :: Palette -- cannot be completely empty, always one default shape
+empty = Palette [("circle", Shape.circle)]
hunk ./src/State.hs 11
+ , getPalette, setPalette
hunk ./src/State.hs 17
+import Palette
hunk ./src/State.hs 30
+ , stPalette :: Palette.Palette -- available node shapes
hunk ./src/State.hs 48
+ , stPalette = Palette.empty
hunk ./src/State.hs 69
+getPalette :: State -> IO Palette.Palette
+getPalette = getFromState stPalette
+
hunk ./src/State.hs 89
+
+setPalette :: Palette.Palette -> State -> IO ()
+setPalette palette stateRef =
+ varUpdate_ stateRef (\state -> state { stPalette = palette })
}