Thu Mar 16 14:44:16 WET 2006 Miguel Vilaca <jmvilaca@di.uminho.pt>
* New Agents
It's now possible to create new agents giving their names, symbols and the list of ports.
Also is possible to save the new palette to a palette file.
{
binary ./INblobs.png
hunk ./src/Common.hs 183
-removeQuotes = init . tail
+removeQuotes ('"':str) = init str
+removeQuotes str = str [_$_]
hunk ./src/NetworkUI.hs 343
+ -- Palette menu
+ ; palMenu <- menuPane [ text := "&Palette" ]
+ ; menuItem palMenu [_$_]
+ [ text := "Save palette as ..."
+ , on command := safetyNet theFrame $ savePalette theFrame state
+ ]
hunk ./src/NetworkUI.hs 374
- ; logMessage "logging enabled"
hunk ./src/NetworkUI.hs 387
- [ menuBar := [ fileMenu, editMenu, viewMenu, opsMenu ]
+ [ menuBar := [ fileMenu, editMenu, viewMenu, opsMenu, palMenu ]
hunk ./src/NetworkUI.hs 477
-extensions :: [(String, [String])]
+extensions,paletteExtensions :: [(String, [String])]
hunk ./src/NetworkUI.hs 479
+paletteExtensions = [ ("Shape palettes (." ++ paletteExt ++ ")", ["*." ++ paletteExt]) ]
hunk ./src/NetworkUI.hs 608
- [ ("Shape palettes (." ++ paletteExt ++ ")", ["*." ++ paletteExt]) ]
+ paletteExtensions [_$_]
hunk ./src/NetworkUI.hs 649
- [_$_]
+
+savePalette :: Show n => Frame () -> State g n e -> IO ()
+savePalette theFrame state =
+ do pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+ mfname <- PD.defaultSaveAsDialog theFrame paletteExtensions Nothing
+ case mfname of
+ Just fname -> do safeWriteFile theFrame fname . show $ getPalette doc
+ return ()
+ Nothing -> return ()
hunk ./src/NetworkUI.hs 705
+
+ button <- button panel [ text := "add new agent"
+ , on command := createNewAgentItem state
+ ]
hunk ./src/NetworkUI.hs 710
- set panel [layout := boxed "Palette" (grid 4 4 table) ]
+ set panel [layout := column 5 [ boxed "Palette" (grid 4 4 table)
+ , widget button
+ ] ]
hunk ./src/NetworkUI.hs 741
+
+createNewAgentItem :: InfoKind n g => State g n e -> IO ()
+createNewAgentItem state = [_$_]
+ do mRes <- createAgentByNameDialog state
+ case mRes of
+ Just (agentName, agentShape, ports) -> [_$_]
+ do{ pDoc <- getDocument state
+ ; let newElem = (agentName, (agentShape, Just ports, Nothing))
+ ; PD.updateDocument "change palette"
+ (\doc -> setPalette (Palette . (++ [newElem]) . shapes . getPalette $ doc) [_$_]
+ doc)
+ pDoc
+ [_$_]
+ ; setCurrentShape (agentName) state
hunk ./src/NetworkUI.hs 756
+ ; buildVisiblePalette state
+ }
+ _ -> return ()
hunk ./src/NetworkUI.hs 1120
+
+createAgentByNameDialog :: State g n e -> IO (Maybe (String, Shape, [Port]))
+createAgentByNameDialog state =
+ do theFrame <- getNetworkFrame state
+ pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+ [_$_]
+ -- palette shape names
+ let paletteNames = map fst . shapes $ getPalette doc
+
+ -- create Dialog [_$_]
+ diaW <- dialog theFrame [ text := "Create new agent"
+ , visible := True
+ , resizeable := True
+ , clientSize := sz 200 300
+ ]
+ p <- panel diaW []
+
+ agent <- entry p [text := "agent name"]
+ -- set agent [ on keyboard := \k -> do propagateEvent
+ -- agentD <- get agent text
+ -- if agentD `elem` paletteNames [_$_]
+ -- then set agent [bgcolor := red]
+ -- else set agent [bgcolor := green] ]
+ symb <- entry p [text := "agent symbol" ]
+ -- set symb [ on keyboard := \k -> do propagateEvent
+ -- set symb [ bgcolor := green ]
+ -- repaint agentG
+ portsC <- textCtrl p [text := "[ (\"port_name\", DoublePoint 0.3 (-0.3))\n]" ]
+ -- set portsC [ on keyboard := \k -> do propagateEvent
+ -- portsT <- get portsC text
+ -- case (reads :: ReadS [Port] ) portsT of
+ -- [(ports,"")] -> do set portsC [ bgcolor := green]
+ -- repaint agentG [_$_]
+ -- _ -> set portsC [ bgcolor := red]
+
+ agentG <- button p [ text := "agent"
+ , style := wxNO_BORDER
+ , bgcolor := wxcolor paneBackgroundColor [_$_]
+ , on paint := \dc r -> safetyNet theFrame $ [_$_]
+ do { symbD <- get symb text
+ ; portsT <- get portsC text
+ [_$_]
+ ; case (reads :: ReadS [Port] ) portsT of
+ [(ports,"")] -> [_$_]
+ do let shape = [_$_]
+ TextInEllipse { shapeStyle = defaultShapeStyle
+ , shapeText = symbD}
+ [_$_]
+ drawFig dc r shape (Just ports) [] [_$_]
+ [_$_]
+ _ -> logMessage "bad parsing in ports" -- return ()
+ }
+ ]
+ set agentG [ on command := repaint agentG ]
+
+ test <- button p [text := "Test", on command := repaint agentG]
+
+ ok <- button p [ text := "Ok"]
+ ca <- button p [ text := "Cancel" ]
+
+ set diaW [ layout := container p $ [_$_]
+ margin 10 $ fill $ [_$_]
+ column 5 [ boxed "New agent with" $ fill
+ $ grid 5 5 [_$_]
+ [[label "agent name", hfill $ widget agent]
+ ,[label "agent symbol", hfill $ widget symb]
+ ,[label "list of ports", hfill $ widget portsC]]
+ , hfill $ widget test
+ , fill $ widget agentG
+ , floatBottomRight $ row 5 [widget ok, widget ca]
+ ]
+ ]
+
+ showModal diaW $ \stop -> [_$_]
+ do set ok [on command := [_$_]
+ do{ agentD <- get agent text
+ ; symbD <- get symb text
+ ; portsT <- get portsC text
+
+ ; if agentD `elem` paletteNames [_$_]
+ then do { errorDialog diaW "Repeated agent name" $ "Already exists one agent with name «" ++ agentD ++ "». Choose a different one."
+ -- ; set agent [bgcolor := red]
+ }
+ else [_$_]
+ do let shape = TextInEllipse { shapeStyle = defaultShapeStyle
+ , shapeText = symbD}
+ case (reads :: ReadS [Port] ) portsT of
+ [(ports,"")] -> stop $ Just (agentD, shape, ports)
+ _ -> do { errorDialog diaW "Parse error in list of Ports" "Parse error in list of Ports" [_$_]
+ -- ; set portsC [ bgcolor := red ]
+ } [_$_]
+ }
+ ]
+ set ca [on command := stop Nothing ]
hunk ./src/Ports.hs 10
+ , drawFig [_^M_][_$_]
hunk ./src/Ports.hs 81
+[_^M_][_$_]
+drawFig :: DC () -> Rect -> Shape -> Maybe Ports -> [Prop (DC ())] -> IO ()[_^M_][_$_]
+drawFig dc r shape ports options = [_^M_][_$_]
+ do{[_^M_][_$_]
+ -- Scale if the DC we are drawing to has a different PPI from the screen[_^M_][_$_]
+ ; dcPPI <- dcGetPPI dc[_^M_][_$_]
+ ; screenPPI <- getScreenPPI[_^M_][_$_]
+ ; when (dcPPI /= screenPPI) $[_^M_][_$_]
+ dcSetUserScale dc[_^M_][_$_]
+ (fromIntegral (sizeW dcPPI ) / fromIntegral (sizeW screenPPI ))[_^M_][_$_]
+ (fromIntegral (sizeH dcPPI ) / fromIntegral (sizeH screenPPI ))[_^M_][_$_]
+[_^M_][_$_]
+ -- Set font[_^M_][_$_]
+ ; set dc [ fontFamily := FontDefault, fontSize := 10 ][_^M_][_$_]
+[_^M_][_$_]
+ ; let ppi = screenPPI[_^M_][_$_]
+ -- center of drawing area[_^M_][_$_]
+ center = screenToLogicalPoint ppi $ rectCentralPoint r [_^M_][_$_]
+[_^M_][_$_]
+ ; logicalDraw ppi dc center shape options[_^M_][_$_]
+ ; drawPorts ppi dc center ports options[_^M_][_$_]
+ }[_^M_][_$_]
+[_^M_][_$_]
}