Wed Aug 17 16:39:09 WEST 2005 Malcolm.Wallace@cs.york.ac.uk
* allow different shape nodes
Added a fairly general Shape description type, to allow arbitrary shapes
of nodes. For now however, the diagram editor only allows switching
between circles and squares.
{
hunk ./Makefile 23
+ src/Shape.hs \
hunk ./Makefile 121
+src/Node.o : src/Constants.hi
+src/Node.o : src/Shape.hi
hunk ./Makefile 148
+src/NetworkView.o : lib/DData/IntMap.hi
hunk ./Makefile 164
+src/NetworkControl.o : src/NetworkView.hi
hunk ./Makefile 169
+src/ContextMenu.o : src/Shape.hi
hunk ./Makefile 171
+src/ContextMenu.o : src/Math.hi
hunk ./src/ContextMenu.hs 13
+import Shape
hunk ./src/ContextMenu.hs 95
+ ; menuLine contextMenu
+ ; 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
+ ]
hunk ./src/Math.hs 13
+ , translate
hunk ./src/Math.hs 60
+
+-- | Translate a point relative to a new origin
+translate :: DoublePoint -> DoublePoint -> DoublePoint
+translate (DoublePoint originX originY) (DoublePoint x y) =
+ DoublePoint (x+originX) (y+originY)
hunk ./src/NetworkControl.hs 9
+ , changeNodeShape
hunk ./src/NetworkControl.hs 24
+import Shape
hunk ./src/NetworkControl.hs 40
+ ; repaintAll state
+ }
+ _ -> return ()
+ }
+
+changeNodeShape :: Shape -> State -> IO ()
+changeNodeShape shape state = [_$_]
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; case getSelection doc of
+ NodeSelection nodeNr -> [_$_]
+ do{ PD.updateDocument "change shape"
+ (updateNetwork [_$_]
+ (updateNode nodeNr [_$_]
+ (Node.setShape shape))) pDoc
hunk ./src/NetworkFile.hs 89
+ , simpleString "Shape" (show (getShape node))
hunk ./src/NetworkFile.hs 237
+ ; shape <- getStringInsideTag "Shape" contents "Node"
hunk ./src/NetworkFile.hs 240
- ["LabelAbove", "X", "Y", "Name" ]
+ ["LabelAbove", "X", "Y", "Name", "Shape" ]
hunk ./src/NetworkFile.hs 244
- , Node.create name (DoublePoint x y) labelAbove
+ , setShape (read shape) $
+ Node.create name (DoublePoint x y) labelAbove
hunk ./src/NetworkView.hs 18
-import Graphics.UI.WX hiding (Vector)
+import Graphics.UI.WX as WX hiding (Vector)
hunk ./src/NetworkView.hs 22
+import Shape
hunk ./src/NetworkView.hs 79
- ; logicalCircle ppi dc center kNODE_RADIUS
+ ; logicalDraw ppi dc center shape
+ -- ; logicalCircle ppi dc center kNODE_RADIUS
hunk ./src/NetworkView.hs 104
+ shape = Node.getShape node
hunk ./src/NetworkView.hs 200
- circle dc (logicalToScreenPoint ppi center) (logicalToScreenX ppi radius) options
+ WX.circle dc (logicalToScreenPoint ppi center) (logicalToScreenX ppi radius) options
hunk ./src/NetworkView.hs 214
+{-
hunk ./src/NetworkView.hs 227
+-}
hunk ./src/Node.hs 7
+ , getShape, setShape
hunk ./src/Node.hs 11
+import Shape
+import Constants
hunk ./src/Node.hs 18
+ , nodeShape :: Shape
+ , nodeInfo :: a
hunk ./src/Node.hs 28
+ , nodeShape = Circle { shapeRadius=kNODE_RADIUS }
hunk ./src/Node.hs 37
+getShape :: Node a -> Shape
+getShape node = nodeShape node
+
hunk ./src/Node.hs 52
+
+setShape :: Shape -> Node a -> Node a
+setShape s node = node { nodeShape = s }
addfile ./src/Shape.hs
hunk ./src/Shape.hs 1
+module Shape where
+
+import CommonIO
+import Graphics.UI.WX as WX
+import Graphics.UI.WXCore -- hiding (Document, screenPPI)
+import Graphics.UI.WXCore.Draw
+import Math
+
+import Constants
+
+data Shape =
+ Circle { shapeStyle :: ShapeStyle, shapeRadius :: Double }
+ | Polygon { shapeStyle :: ShapeStyle, shapePerimeter :: [DoublePoint] }
+ -- centred on (0,0)
+ | Lines { shapeStyle :: ShapeStyle, shapePerimeter :: [DoublePoint] }
+ -- no fill for open shape
+ | Composite { shapeSegments :: [Shape] } -- drawn in given order
+ deriving (Eq, Show, Read)
+
+-- not currently used
+data ShapeStyle = ShapeStyle
+ { styleStrokeWidth :: Double
+ , styleStrokeColour :: Color
+ , styleFill :: Color
+ }
+ deriving (Eq {-, Show, Read-})
+instance Show ShapeStyle where show _ = ""
+instance Read ShapeStyle where readsPrec _ s = [(ShapeStyle {}, s)]
+
+logicalDraw :: Size -> DC () -> DoublePoint -> Shape -> [Prop (DC ())] -> IO ()
+logicalDraw ppi dc centre shape options =
+ case shape of
+ Circle {} -> WX.circle dc (logicalToScreenPoint ppi centre)
+ (logicalToScreenX ppi (shapeRadius shape))
+ options
+ Polygon {} -> WX.polygon dc (map (logicalToScreenPoint ppi
+ . translate centre)
+ (shapePerimeter shape))
+ options
+ Lines {} -> logicalLineSegments ppi dc (shapePerimeter shape) options
+ Composite {}-> mapM_ (\s-> logicalDraw ppi dc centre s options)
+ (shapeSegments shape)
+
+logicalLineSegments :: Size -> DC () -> [DoublePoint] -> [Prop (DC ())] -> IO ()
+logicalLineSegments _ _ [p] options = return ()
+logicalLineSegments ppi dc (fromPoint:toPoint:ps) options =
+ do{ line dc (logicalToScreenPoint ppi fromPoint)
+ (logicalToScreenPoint ppi toPoint) options
+ ; logicalLineSegments ppi dc (toPoint:ps) options
+ }
+
+circle,square :: Shape
+circle = Circle { shapeRadius = kNODE_RADIUS }
+square = Polygon { shapePerimeter = [ DoublePoint (-0.5) (-0.5)
+ , DoublePoint 0.5 (-0.5)
+ , DoublePoint 0.5 0.5
+ , DoublePoint (-0.5) 0.5 ] }
}