Tue Mar 21 18:21:13 WET 2006 Miguel Vilaca <jmvilaca@di.uminho.pt>
* Usability improvements
- Changes menu item 'Change shape palette' from menu 'Edit'
to menu 'Palette' and adds a confirm dialog to this
dangerous operation.
- Adds buttons 'Add new rule' and
'Create new Interaction Net rule'.
- Removes buttons 'Add new agent' from dialog
'Create new Interaction net rule'.
- Test if palette without interface agent is empty in
'Create new Interaction net rule'.
- Readjustment in ports's colors; port of interface agents
are painted differently.
- New graphical way to generate textual descriptions
- Possibility to generate partial textual descriptions;
just rules or just net.
- When loading new palettes, checks if the set of new
names contains the set of old names.
- Loading the palette is not a document operation anymore.
{
hunk ./Makefile 27
- src/INTextual.hs \
+ src/INTextual.hs src/INTextualUI.hs \
hunk ./Makefile 99
-src/Main.o : src/INTextual.hi
+src/Main.o : src/INTextualUI.hi
hunk ./Makefile 263
-src/INTextual.o : src/Operations.hi
hunk ./Makefile 266
-src/INTextual.o : src/SafetyNet.hi
hunk ./Makefile 268
-src/INTextual.o : src/State.hi
hunk ./Makefile 271
+src/INTextualUI.o : src/INTextualUI.hs
+src/INTextualUI.o : src/INTextual.hi
+src/INTextualUI.o : src/SafetyNet.hi
+src/INTextualUI.o : src/Operations.hi
+src/INTextualUI.o : src/InfoKind.hi
+src/INTextualUI.o : src/State.hi
hunk ./src/Constants.hs 35
+
hunk ./src/Constants.hs 37
-kPortPenColor = blue :: Color
+kPortPenColor = yellow :: Color
hunk ./src/Constants.hs 39
+
+kPrincipalPortPenColor = green :: Color [_$_]
hunk ./src/Constants.hs 42
-kPortSelectedColor = red :: Color
hunk ./src/Constants.hs 43
+
+kInterfacePortPenColor = blue :: Color
+kInterfacePortBrushColor = blue :: Color
+
+kPortSelectedColor = red :: Color
hunk ./src/INTextual.hs 4
- , printNetEquations
- , printSimplifiedNetEquations
- , saveNetEquations
- , saveSimplifiedNetEquations
+ , doc2net
+ , network2net
+ , textualRule
+ , toRuleNet -- tricky function with unsafe operations inside
+ , simplify
+ , filterRules
+ , filterNet
hunk ./src/INTextual.hs 13
-import Operations
hunk ./src/INTextual.hs 16
-import SafetyNet
hunk ./src/INTextual.hs 20
-import Graphics.UI.WXCore hiding (Document)
hunk ./src/INTextual.hs 21
-import State
hunk ./src/INTextual.hs 294
------------------------------------------------------------------------------
hunk ./src/INTextual.hs 295
-printNetEquations, printSimplifiedNetEquations :: (InfoKind n g, InfoKind e g) => IOOp g n e
-printNetEquations = auxPrintNet False
-printSimplifiedNetEquations = auxPrintNet True
+filterRules :: Net -> Net
+filterRules net = net { equations = [], interface = [] }
hunk ./src/INTextual.hs 298
-auxPrintNet :: (InfoKind n g, InfoKind e g) => Bool -> IOOp g n e
-auxPrintNet b doc _ = [_$_]
- do logMessage "printing Net"
- logMessage (show net)
- print net
- where net = simp $ doc2net doc
- simp = if b then simplify else id
-
-
-saveNetEquations, saveSimplifiedNetEquations :: (InfoKind n g, InfoKind e g) => IOOp g n e
-saveNetEquations = auxSaveNetEquations False
-saveSimplifiedNetEquations = auxSaveNetEquations True
-
-auxSaveNetEquations :: (InfoKind n g, InfoKind e g) => Bool -> IOOp g n e
-auxSaveNetEquations b doc state = [_$_]
- do w <- getNetworkFrame state
- safetyNet w $
- do [_$_]
- mf <- fileSaveDialog w [_$_]
- rememberCurrentDir overwritePrompt [_$_]
- "Save net equations"
- [("Any file", ["*"])] [_$_]
- directory filename
- case mf of
- Nothing -> return ()
- Just fn -> writeFile fn . show . simp $ doc2net doc
- where rememberCurrentDir = True
- overwritePrompt = True
- directory = "" [_$_]
- filename = "" [_$_]
- simp = if b then simplify else id
-
+filterNet :: Net -> Net
+filterNet net = net { rules = []} [_$_]
addfile ./src/INTextualUI.hs
hunk ./src/INTextualUI.hs 1
+module INTextualUI [_$_]
+ ( genTextual
+ ) where
+
+import Operations
+import SafetyNet
+import INTextual
+import InfoKind
+import State
+
+import Graphics.UI.WXCore hiding (Document)
+import Graphics.UI.WX
+
+
+data What = Everything | JustRules | JustNet [_$_]
+
+-- Generate textual descrition
+genTextual :: (InfoKind n g, InfoKind e g) => IOOp g n e
+genTextual doc state = [_$_]
+ do mRes <- genTextualDialog state
+ case mRes of [_$_]
+ Nothing -> return ()
+ Just (what, simp, wher) -> [_$_]
+ do let simpF = if simp then simplify else id
+ filt = case what of
+ Everything -> id
+ JustRules -> filterRules
+ JustNet -> filterNet
+ net = filt . simpF $ doc2net doc
+
+ if wher [_$_]
+ then -- save to file
+ do w <- getNetworkFrame state
+ safetyNet w $
+ do [_$_]
+ mf <- fileSaveDialog w [_$_]
+ rememberCurrentDir overwritePrompt [_$_]
+ "Save net equations"
+ [("Any file", ["*"])] [_$_]
+ directory filename
+ case mf of
+ Nothing -> return ()
+ Just fn -> writeFile fn . show $ net
+ [_$_]
+ else -- print to screen
+ do logMessage "printing Net"
+ logMessage (show net)
+ print net
+ where rememberCurrentDir = True
+ overwritePrompt = True
+ directory = "" [_$_]
+ filename = "" [_$_]
+
+genTextualDialog :: State g n e -> IO (Maybe (What, Bool, Bool))
+genTextualDialog state = [_$_]
+ do theFrame <- getNetworkFrame state
+ [_$_]
+ dialog <- dialog theFrame [_$_]
+ [ text := "Generate Textual Description"
+ , visible := True
+ ]
+ p <- panel dialog []
+
+ let infoWhat = [ ("the all system", Everything)
+ , ("agents and rules", JustRules)
+ , ("agents and net",JustNet)
+ ]
+ (labelsWhat,dataWhat) = unzip infoWhat
+
+ rWhat <- radioBox p Vertical labelsWhat [_$_]
+ [ text := "Of :"
+ , selection := 0 ]
+
+ let infoSimp = [ ("simplified", True)
+ , ("not simplified", False)
+ ]
+ (labelsSimp,dataSimp) = unzip infoSimp
+
+ rSimp <- radioBox p Vertical labelsSimp [_$_]
+ [ text := "Version :"
+ , selection := 0 ]
+
+ let infoWhere = [ ("save to file", True)
+ , ("print to screen", False)
+ ]
+ (labelsWhere,dataWhere) = unzip infoWhere
+
+ rWhere <- radioBox p Vertical labelsWhere [_$_]
+ [ text := "To :"
+ , selection := 0 ]
+
+ ok <- button p [ text := "Ok" ]
+
+ set dialog [ layout := container p $
+ margin 10 $ [_$_]
+ column 5 [ label "Generate textual descrition"
+ , widget rWhat
+ , widget rSimp [_$_]
+ , widget rWhere
+ , hfloatCentre $ widget ok [_$_]
+ ]
+ ]
+
+ showModal dialog $ \stop ->
+ do set ok [on command := [_$_]
+ do iWhat <- get rWhat selection
+ iSimp <- get rSimp selection
+ iWhere <- get rWhere selection
+
+ stop (Just ( dataWhat !! iWhat
+ , dataSimp !! iSimp
+ , dataWhere !! iWhere)
+ ) ]
hunk ./src/Main.hs 15
-import INTextual
+import INTextualUI
hunk ./src/Main.hs 35
- , ioOps = [ ("generate equations from interaction net"
- , printNetEquations)
- , ("generate simplified equations from interaction net"
- , printSimplifiedNetEquations)
- , ("save equations to file"
- , saveNetEquations)
- , ("save simplified equations to file"
- , saveSimplifiedNetEquations)
+ , ioOps = [ ("Generate textual description"
+ , genTextual)
hunk ./src/NetworkUI.hs 74
+ ******* palPan :: Panel ()
+ ******* addAgent :: Button ()
hunk ./src/NetworkUI.hs 78
+ ******* buttonNewRule :: Button ()
+ ******* buttonNewIRule :: Button ()
hunk ./src/NetworkUI.hs 105
- ; setPalettePanel palettePan state
+ ; palPan <- panel palettePan [] [_$_]
+ ; setPalettePanel palPan state
hunk ./src/NetworkUI.hs 298
- ; menuItem editMenu
- [ text := "Change shape palette..."
- , on command := safetyNet theFrame $ openPalette theFrame state
- ]
hunk ./src/NetworkUI.hs 356
+ ; menuItem palMenu
+ [ text := "Change shape palette..."
+ , on command := safetyNet theFrame $ [_$_]
+ do yes <- confirmDialog theFrame "Dangerous operation!!" "Changing the palette can leads to severe errors.\nUnless you know what you you are doing, don't proceed.\nDo you really want to proceed ?" False
+ when yes $ openPalette theFrame state
+ ]
hunk ./src/NetworkUI.hs 389
- [_$_]
- [_$_]
- ; openPaletteFile palette state (Just theFrame) [_$_]
- [_$_]
hunk ./src/NetworkUI.hs 390
+ ; let interfacePal = [_$_]
+ Palette [_$_]
+ [ ("interface"
+ , ( Circle { shapeStyle = ShapeStyle
+ { styleStrokeWidth = 2
+ , styleStrokeColour = RGB 255 255 255
+ , styleFill = RGB 255 255 255
+ }
+ , shapeRadius = 0.25
+ }
+ , Just [("interface", DoublePoint 0.0 0.25)]
+ , Just n ))
+ ]
+
+ -- set the initial palette only with interface agent [_$_]
+ ; PD.superficialUpdateDocument (setPalette interfacePal) pDoc
+ ; setCurrentShape "interface" state
+
+ ; buildVisiblePalette state
+ [_$_]
hunk ./src/NetworkUI.hs 425
+ ; buttonNewRule <- button rulesTreePan [_$_]
+ [ text := "Add new rule" [_$_]
+ , on command := safetyNet theFrame $ addNewRuleItem state $ initial g n e
+ ]
+ ; buttonNewIRule <- button rulesTreePan [_$_]
+ [ text := "Create new Interaction Net rule" [_$_]
+ , on command := safetyNet theFrame $ createRuleItem theFrame state g n e
+ ]
+
+
+ ; addAgent <- button palettePan [ text := "add new agent"
+ , on command := createNewAgentItem state
+ ]
+
+ ; set palettePan [ layout := column 5 [ widget palPan
+ , hfloatCentre $ widget addAgent ] ] [_$_]
+
hunk ./src/NetworkUI.hs 450
- (container rulesTreePan $ fill $ widget tree) )
+ (container rulesTreePan $ [_$_]
+ column 5 [ fill $ widget tree
+ , hfloatCentre $ widget buttonNewRule
+ , hfloatCentre $ widget buttonNewIRule
+ ]
+ ) [_$_]
+ )
hunk ./src/NetworkUI.hs 697
- ; let palette = removeQuotesFromNames p
- ; PD.updateDocument "change palette"
- (setPalette palette)
- -- really ought to go through network and
- -- change all nodes' stored shape.
- pDoc
- --; put here code to rebuild Visible Palette
- -- the shape name of the first palette element is choosed
- -- as the default one
- ; setCurrentShape (fst . head . shapes $ palette) state
+ ; doc <- PD.getDocument pDoc
+ ; let newPalette = removeQuotesFromNames p
+ oldPalette = getPalette doc [_$_]
+ newNames = shapesNames newPalette
+ oldNames = shapesNames oldPalette [_$_]
+ [_$_]
+ ; let cont = newNames `union` oldNames == newNames
+ ; yes <- if cont [_$_]
+ then return True
+ else [_$_]
+ case exceptionsFrame of [_$_]
+ Nothing -> return False
+ Just f -> confirmDialog f [_$_]
+ "Conflict with palettes" [_$_]
+ ("The old palette has names that are not defined in the one that you intend to load.\nThis can make the system inconsistent.\n\nDo you want to load the new palette anyway ?") False
+ ; when (cont || yes) $ [_$_]
+ do PD.updateDocument "change palette"
+ (setPalette newPalette)
+ pDoc
+ -- the shape name of the first palette element is choosed
+ -- as the default one
+ setCurrentShape (fst . head . shapes $ newPalette) state
hunk ./src/NetworkUI.hs 720
- ; buildVisiblePalette state
+ buildVisiblePalette state
hunk ./src/NetworkUI.hs 785
- button <- button panel [ text := "add new agent"
- , on command := createNewAgentItem state
- ]
-
- set panel [layout := column 5 [ boxed "Palette" (grid 4 4 table)
- , widget button
- ] ]
+ set panel [layout := boxed "Palette" (grid 4 4 table) ]
hunk ./src/NetworkUI.hs 1130
- let palette = Palette . filter ( (/= "interface").fst ) [_$_]
+ let pal = filter ( (/= "interface").fst ) [_$_]
hunk ./src/NetworkUI.hs 1133
- -- no button was pressed
- setShape1 Nothing state
- setShape2 Nothing state
+ if null pal [_$_]
+ then [_$_]
+ do warningDialog theFrame "No agents" "There are no agents other then interface ones.\nAdd agents first."
+ return Nothing
+ else [_$_]
+ do let palette = Palette pal
+ -- no button was pressed
+ setShape1 Nothing state
+ setShape2 Nothing state
hunk ./src/NetworkUI.hs 1143
- -- create Dialog [_$_]
- dia <- dialog theFrame [ text := "Choose agents", visible := True]
- p <- panel dia []
- p1 <- panel p []
- p2 <- panel p []
+ -- create Dialog [_$_]
+ dia <- dialog theFrame [ text := "Choose agents", visible := True]
+ p <- panel dia []
+ p1 <- panel p []
+ p2 <- panel p []
hunk ./src/NetworkUI.hs 1149
- reallyBuildVisiblePalette palette p1 state $ onClick setJustShape1 [_$_]
- reallyBuildVisiblePalette palette p2 state $ onClick setJustShape2
+ reallyBuildVisiblePalette palette p1 state $ onClick setJustShape1 [_$_]
+ reallyBuildVisiblePalette palette p2 state $ onClick setJustShape2
hunk ./src/NetworkUI.hs 1152
- let rinfo = [ ("all nodes", Everything)
- , ( "just interface nodes", JustInterface)
- , ("nothing", DontCopy) [_$_]
- ]
- (rlabels, rdata) = unzip rinfo
- r1 <- radioBox p Vertical rlabels [_$_]
- [ text := "What to copy automatically from LHS to RHS ?"
- , selection := 1 ]
+ let rinfo = [ ("all nodes", Everything)
+ , ( "just interface nodes", JustInterface)
+ , ("nothing", DontCopy) [_$_]
+ ]
+ (rlabels, rdata) = unzip rinfo
+ r1 <- radioBox p Vertical rlabels [_$_]
+ [ text := "What to copy automatically from LHS to RHS ?"
+ , selection := 1 ]
hunk ./src/NetworkUI.hs 1161
- ok <- button p [ text := "Ok"
+ ok <- button p [ text := "Ok"
hunk ./src/NetworkUI.hs 1164
- setOkButton ok state
+ setOkButton ok state
hunk ./src/NetworkUI.hs 1166
- ca <- button p [ text := "Cancel" ]
+ ca <- button p [ text := "Cancel" ]
hunk ./src/NetworkUI.hs 1169
- set dia [ layout := container p $ [_$_]
- margin 10 $ [_$_]
- column 5 [ label "Choose one agent in each palette."
- , widget p1
- , widget p2
- , widget r1
- , row 5 [widget ok, widget ca]
- ]
- ]
+ set dia [ layout := container p $ [_$_]
+ margin 10 $ [_$_]
+ column 5 [ label "Choose one agent in each palette."
+ , widget p1
+ , widget p2
+ , widget r1
+ , row 5 [widget ok, widget ca]
+ ]
+ ]
hunk ./src/NetworkUI.hs 1179
- showModal dia $ \stop -> [_$_]
+ showModal dia $ \stop -> [_$_]
hunk ./src/Palette.hs 26
+shapesNames :: Palette a -> [String]
+shapesNames = map fst . shapes
+
hunk ./src/Ports.hs 46
+ Just [("interface",position)] -> drawPrincipalPort ppi dc centre optionsIP position
hunk ./src/Ports.hs 55
- -- penWidth := kPortPenWidth
- -- penColor := kPortPenColor
hunk ./src/Ports.hs 56
- , penColor := kPortBrushColor [_$_]
+ , penColor := kPortPenColor [_$_]
hunk ./src/Ports.hs 59
- , penColor := kPrincipalPortBrushColor [_$_]
+ , penColor := kPrincipalPortPenColor [_$_]
+ ] ++ options'
+ optionsIP = [ brushColor := kInterfacePortBrushColor [_$_]
+ , penColor := kInterfacePortPenColor [_$_]
}