Mon Nov 6 15:53:01 WET 2006 Daniel Mendes <danielmendes@portugalmail.com>
* Management Rule Template's
The 'Create new rule wizard' has now the ability to create Management rules from predefined templates.
{
addfile ./palettes/ManagementAgents.INblobpalette
hunk ./palettes/ManagementAgents.INblobpalette 1
+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 [])),("copy",(TextInEllipse {shapeStyle = ShapeStyle {styleStrokeWidth = 1, styleStrokeColour = RGB 0 0 0, styleFill = RGB 192 192 192}, shapeText = "c"},Just [("src",DoublePoint 0.0 0.3),("fst_target",DoublePoint (-0.3) (-0.3)),("snd_target",DoublePoint 0.3 (-0.3))],Nothing)),("duplicator",(Composite {shapeSegments = [Circle {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.5},Arc {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.2, shapeStart = 70.0, shapeEnd = 270.0, shapeCenter = DoublePoint 0.0 (-0.18)},Arc {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.2, shapeStart = 150.0, shapeEnd = 90.0, shapeCenter = DoublePoint 0.0 0.18}]},Just [("down",DoublePoint 0.0 0.5),("copy1",DoublePoint (-0.3) (-0.3)),("copy2",DoublePoint 0.3 (-0.3))],Just [])),("Erase",(Composite {shapeSegments = [Circle {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.5},Arc {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.2, shapeStart = 90.0, shapeEnd = 270.0, shapeCenter = DoublePoint 0.0 (-0.18)},Arc {shapeStyle = ShapeStyle {styleStrokeWidth = 2, styleStrokeColour = RGB 250 0 0, styleFill = RGB 255 255 255}, shapeRadius = 0.2, shapeStart = 90.0, shapeEnd = 270.0, shapeCenter = DoublePoint 0.0 0.18}]},Just [("down",DoublePoint 0.0 0.5)],Just []))]
hunk ./src/NetworkUI.hs 422
- , on command := safetyNet theFrame $ addNewRuleItem state $ initial g n e
+ , on command := safetyNet theFrame $ addNewRuleItem True state $ initial g n e
hunk ./src/NetworkUI.hs 468
+
hunk ./src/NetworkUI.hs 958
- , on command := safetyNet theFrame $ addNewRuleItem state $ initial g n e
+ , on command := safetyNet theFrame $ addNewRuleItem True state $ initial g n e
hunk ./src/NetworkUI.hs 985
- State g n e -> INRule g n e -> IO ()
-addNewRuleItem state newRule = [_$_]
+ Bool -> State g n e -> INRule g n e -> IO ()
+addNewRuleItem genNewName state newRule = [_$_]
hunk ./src/NetworkUI.hs 990
- let newName = addNew 1 . rulesNames $ getRules doc
+ let newName = if genNewName then (addNew 1 . rulesNames $ getRules doc) else (INRule.getName newRule)
hunk ./src/NetworkUI.hs 993
- (updateRules $ addNewRule $ INRule.setName newName $ newRule) pDoc
+ (updateRules $ addNewRule $ (if genNewName then INRule.setName newName else id) $ newRule ) pDoc
hunk ./src/NetworkUI.hs 1072
-data CopyLHS2RHS = Everything | JustInterface | DontCopy deriving (Show)
+data CopyLHS2RHS = Everything | JustInterface | DontCopy | DefaultRule deriving (Show)
hunk ./src/NetworkUI.hs 1084
- do{ let (agent1, agent2, copyOption) = fromJust maybeRes
- copy = case copyOption of [_$_]
- Everything -> copyLHS2RHS [_$_]
- JustInterface -> copyLHSInterface2RHS [_$_]
- DontCopy -> id
- [_$_]
- ; pDoc <- getDocument state
+ do{ [_$_]
+ ; pDoc <- getDocument state
hunk ./src/NetworkUI.hs 1087
+ ;let ;(agent1, agent2, copyOption) = fromJust maybeRes
+ ;copy = case copyOption of [_$_]
+ Everything -> copyLHS2RHS [_$_]
+ JustInterface -> copyLHSInterface2RHS [_$_]
+ DontCopy -> id
+ DefaultRule -> defaultRuleSelector (agent1,agent2) state g n e (getPalette doc) [_$_]
hunk ./src/NetworkUI.hs 1100
+ ;logMessage $ agent1 ++ agent2 ++ (show copyOption)
hunk ./src/NetworkUI.hs 1130
- ; addNewRuleItem state . copy $ construct "" lhs7 rhs mapping
+ ; addNewRuleItem False state . copy $ construct "" lhs7 rhs mapping
hunk ./src/NetworkUI.hs 1184
- specialFoldl :: DoublePoint -> [NodeNr] -> Network g n e -> Network g n e
- specialFoldl startingPoint nodes net = snd $ foldl gene (startingPoint, net) nodes
- gene :: (DoublePoint, Network g n e) -> NodeNr -> (DoublePoint, Network g n e)
- gene (actual, oldNet) nNr = (translate actual diff, setNodePosition nNr actual oldNet)
- diff = DoublePoint 1.0 0.0
+specialFoldl :: DoublePoint -> [NodeNr] -> Network g n e -> Network g n e
+specialFoldl startingPoint nodes net = snd $ foldl gene (startingPoint, net) nodes
+gene :: (DoublePoint, Network g n e) -> NodeNr -> (DoublePoint, Network g n e)
+gene (actual, oldNet) nNr = (translate actual diff, setNodePosition nNr actual oldNet)
+diff = DoublePoint 1.0 0.0
+
+
+
+
+defaultRuleSelector :: (InfoKind n g, InfoKind e g) => (String,String) -> State g n e-> g ->n -> e -> [_$_]
+ Palette.Palette n -> INRule g n e -> INRule g n e
+defaultRuleSelector (a1,a2) state g n e pal rule = case a2 of
+ "copy" -> copyORduplicatorDefaultRule (a1,a2) rule state g n e pal
+ "duplicator" -> copyORduplicatorDefaultRule (a1,a2) rule state g n e pal
+ "Erase" -> eraseDefaultRule a1 rule state g n e pal
+ _ -> rule
+
+------------------------------------------------------------------------------------------------------------------------
+
+eraseDefaultRule :: (InfoKind n g, InfoKind e g) => String ->INRule g n e -> State g n e -> g -> n -> e -> Palette.Palette n -> (INRule g n e)
+eraseDefaultRule a1 rule state g n e palette = [_$_]
+ let ;newRule = copyLHSInterface2RHS $ construct "" lhs (Network.empty g n e) []
+ ;rhs = getRHS newRule [_$_]
+ ;inter = getNodeAssocs rhs
+ ;(erasers, rhs1) = addNodes "Erase" palette (length inter) rhs
+ ;rhs2 = specialFoldl (DoublePoint 1.0 1.0) erasers rhs1
+ ;rhs3 = addEdgesWithPort (mix (map fst inter) erasers) rhs2
+ in (construct ("Erase_"++a1) lhs rhs3 (getMapping newRule))
+[_^I_][_^I_][_^I_][_^I_][_^I_][_^I_][_^I_][_^I_][_^I_] [_$_]
+ where
+ mix [] [] = []
+ mix (x:y ) (a:b) = [((x,(Just ("interface",DoublePoint 0.0 0.25))),(a,(Just ("down",DoublePoint 0.0 0.5)))) ]++ mix y b
+ mix _ _ = []
+ ;lhs = getLHS rule
+
hunk ./src/NetworkUI.hs 1221
- [_$_]
hunk ./src/NetworkUI.hs 1222
+
+copyORduplicatorDefaultRule :: (InfoKind n g, InfoKind e g) => (String,String) -> INRule g n e ->
+ State g n e -> g -> n -> e -> Palette.Palette n -> (INRule g n e)
+copyORduplicatorDefaultRule (a1,a2) rule state [_$_]
+ g n e palette = let [_$_]
+ newRule = copyLHSInterface2RHS $ construct "" lhs (Network.empty g n e) []
+ rhs = getRHS newRule
+ inter = getNodeAssocs rhs
+ (alphas, rhs1) = addNodes a1 palette 2 rhs
+ alphasNodes = map (\x -> (x,(getNode x rhs1))) alphas
+ (spas,rhs2) = addNodes a2 palette ((length $ fromMaybe [] $ getPorts (snd $ head alphasNodes))-1) rhs1
+ rhs3 = specialFoldl (DoublePoint 1.0 4.0) spas $ (specialFoldl (DoublePoint 1.0 2.0) alphas rhs2)
+ (copyI,alphaI) = splitAt ((length inter)-2) inter
+ rhs4 = makeInterfaceConection (map fst alphaI) alphas $ makeInterfaceConection (map fst copyI) spas rhs3
+ newC = newConections $ makeConnection alphas spas rhs4
+ rhs5 = addEdgesWithJustPort newC rhs4
+ in (construct (a1++"_"++a2) lhs rhs5 (getMapping newRule))
+ where ;lhs = getLHS rule
+-- ;makeInterfaceConection :: [NodeNr] -> [NodeNr] -> Network g n e -> Network g n e
+ ;makeInterfaceConection inter node ne = let pp_i = getInterfaceList inter ne
+ pp_n = getInterfaceList node ne
+ in addEdgesWithJustPort (zip (zip inter pp_i) (zip node pp_n)) ne
+ ;getInterfaceList nodes ne = map head $ filter (/=[]) $ map (fromMaybe []) $ map getPorts $ map (\x -> getNode x ne) nodes
+-- ;makeConnection :: [NodeNr] -> [NodeNr] -> Network g n e ->([((NodeNr,Port),(Int,Int))] , [((NodeNr,Port),(Int,Int))])
+ ;makeConnection alphs sps ne = let
+ ;alp_p = map reverse $ map (drop 1) $ map (\y -> (fromJust $ getPorts $ ( getNode y ne))) alphs
+ ;alp_p_i = map (zip [1..] ) alp_p
+ ;alp_Nr_p = zip [1..] alp_p_i
+ ;alp_fin = zip alphs alp_Nr_p
+ ;sps_p = map (drop 1) $ map (\y -> (fromJust $ getPorts $ ( getNode y ne))) sps
+ ;sps_p_i = map (zip [1..] ) sps_p
+ ;sps_Nr_p = zip [1..] sps_p_i
+ ;sps_fin = zip sps sps_Nr_p
+ in (foldr (++) [] $ map f alp_fin , foldr (++) [] $ map f sps_fin)
+ ;f :: (Int,(Int,([(Int,Port)]))) -> [((NodeNr,Port),(Int,Int))]
+ ;f (_,(_ ,([]))) = [] [_$_]
+ ;f(nodeNr,(node_i,((port_i,port) : l ))) = [((nodeNr,port),(node_i,port_i))] ++ f (nodeNr,(node_i,( l )))
+getOther :: [((NodeNr,Port),(Int,Int))] -> (Int,Int) -> (NodeNr,Port)
+getOther (((nr,p),(ni,pi)) :l) (a,b) | (b == ni) && (a==pi) = (nr,p)
+ | otherwise = getOther l (a,b)
+newConections :: ([((NodeNr,Port),(Int,Int))],[((NodeNr,Port),(Int,Int))]) ->[((NodeNr,Port),(NodeNr,Port))]
+newConections ([],_) = []
+newConections ((((nr,p),(ni,pi)) :l), ll) = [((nr,p), getOther ll (ni,pi) ) ] ++ (newConections (l,ll))
+
+
hunk ./src/NetworkUI.hs 1293
-
- reallyBuildVisiblePalette palette p1 state $ onClick setJustShape1 [_$_]
- reallyBuildVisiblePalette palette p2 state $ onClick setJustShape2
+ ;p3 <- panel p2 []
+[_^I_][_^I_][_^I_] [_$_]
+ ok <- button p [ text := "Ok"
+ , enabled := False [_$_]
+ ]
+ setOkButton ok state[_^I_][_^I_][_^I_] [_$_]
hunk ./src/NetworkUI.hs 1303
+ , ("Management rules template's",DefaultRule)
hunk ./src/NetworkUI.hs 1308
- , selection := 1 ]
+ , selection := 1 [_$_]
hunk ./src/NetworkUI.hs 1310
- ok <- button p [ text := "Ok"
- , enabled := False [_$_]
- ]
- setOkButton ok state
+ ]
hunk ./src/NetworkUI.hs 1314
+ ;set r1 [ on select ::= logSelect pal p2 state (onClick r1 setJustShape2)][_^I_][_^I_][_^I_] [_$_]
+
+
+ reallyBuildVisiblePalette palette p1 state $ onClick r1 setJustShape1 [_$_]
+ reallyBuildVisiblePalette palette p2 state $ onClick r1 setJustShape2
+[_^I_][_^I_][_^I_][_$_]
hunk ./src/NetworkUI.hs 1331
+ [_$_]
hunk ./src/NetworkUI.hs 1337
-
hunk ./src/NetworkUI.hs 1338
-
hunk ./src/NetworkUI.hs 1345
- onClick func name state = [_$_]
+ onClick r1 func name state = [_$_]
hunk ./src/NetworkUI.hs 1349
+ i <- get r1 selection
hunk ./src/NetworkUI.hs 1351
- set okButton [ enabled := isJust mAgent1 && isJust mAgent2]
+ set okButton [ enabled := if (i==3) then (((fromMaybe "" mAgent2) `elem` ["Erase","duplicator","copy"] ) && isJust mAgent1)
+ else (isJust mAgent1 && isJust mAgent2)
+ ]
+ logSelect pal p2 state f w
+ = do ;i <- get w selection
+ ;mAgent2 <- getShape2 state
+ ;mAgent1 <- getShape1 state
+ ;okButton <- getOkButton state
+ ;if (i == 3) [_$_]
+ then do ;set okButton [enabled := (fromMaybe "" mAgent2) `elem` ["Erase","duplicator","copy"] ] [_$_]
+ ;let specialPalette = filter (\x -> (fst x) == "Erase" || (fst x) == "duplicator" || (fst x) == "copy" ) pal
+ ;if (null specialPalette) [_$_]
+ then do ;theFrame <- getNetworkFrame state
+ ;errorDialog theFrame "Not Defined" "No rules defined for any of the agents in the pallete"
+ ;set w [selection := 1]
+ else do{ ; windowChildren p2 >>= mapM objectDelete [_$_]
+ ; n <- panel p2 []
+ ;reallyBuildVisiblePalette (Palette specialPalette) n state f
+ }[_^I_][_^I_][_^I_][_^I_][_^I_][_$_]
+ else do {;set okButton [enabled := (isJust mAgent1 && isJust mAgent2) ] [_$_]
+ ; windowChildren p2 >>= mapM objectDelete [_$_]
+ ; n <- panel p2 []
+ ;reallyBuildVisiblePalette (Palette pal) n state f
+ }
+
+
+
+
hunk ./src/NetworkUI.hs 1504
+
+
+[_^I_][_$_]
+
+
+
+
+
}