Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Code cleaning

  • Loading branch information...
commit 4e85501746c34d51dbe0ace368d990520c649874 1 parent 485aa1b
@ivanperez-keera ivanperez-keera authored
View
1  SoOSiM-ui.cabal
@@ -69,6 +69,7 @@ Executable SoOSiM-ui
, base >= 4.0 && < 5.0
, ghc
, containers
+ , IfElse
, mtl
, stm
View
12 data/Interface.glade
@@ -315,7 +315,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkIconView" id="iconview1">
+ <object class="GtkIconView" id="infoIconView">
<property name="visible">True</property>
<property name="can_focus">True</property>
</object>
@@ -330,7 +330,7 @@
</packing>
</child>
<child>
- <object class="GtkNotebook" id="notebook3">
+ <object class="GtkNotebook" id="infoSelNotebook">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="show_tabs">False</property>
@@ -362,7 +362,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkTextView" id="textview1">
+ <object class="GtkTextView" id="infoTextView">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="editable">False</property>
@@ -398,7 +398,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkTextView" id="textview2">
+ <object class="GtkTextView" id="traceTextView">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="editable">False</property>
@@ -526,7 +526,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkEventBox" id="eventbox1">
+ <object class="GtkEventBox" id="overviewEventBox">
<property name="width_request">200</property>
<property name="height_request">150</property>
<property name="visible">True</property>
@@ -595,7 +595,7 @@
<property name="can_focus">False</property>
<property name="spacing">2</property>
<child>
- <object class="GtkLabel" id="label12">
+ <object class="GtkLabel" id="statusLbl">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="xalign">0</property>
View
99 src/Controller/Conditions/InfoBasicInfo.hs
@@ -1,30 +1,30 @@
-- | Condition: the notebook showing the component info will show basic info of
-- the currently selected component
module Controller.Conditions.InfoBasicInfo
- (installHandlers, getElemInfo)
+ (installHandlers)
where
-- External imports
-import Control.Concurrent.STM
-import Control.Monad
-import Control.Monad.Trans
-import Data.CBMVar
-import Data.List
-import Graphics.UI.Gtk
-import Hails.MVC.Model.ProtectedModel.Reactive
-import qualified Data.IntMap as I
-import qualified SoOSiM.Types as S
-import Unique
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.IfElse
+import Data.CBMVar
+import qualified Data.IntMap as I
+import Data.List
+import Graphics.UI.Gtk
+import qualified SoOSiM.Types as S
-- Local imports
import CombinedEnvironment
+import Data.Tuple4
import Graphics.Diagrams.MultiCoreStatus
import Graphics.Diagrams.Types
+import Graphics.UI.Gtk.Multiline.TextBufferHelpers
-- | Selects the appropriate page in the info notebook as the user
-- chooses between basic info and component trace
installHandlers :: CEnv -> IO()
-installHandlers cenv = void $ do
+installHandlers cenv = void $
installCallbackCBMVar mcsRef $ conditionShowCompInfo cenv
where mcsRef = mcs (view cenv)
@@ -32,69 +32,64 @@ installHandlers cenv = void $ do
conditionShowCompInfo :: CEnv -> IO()
conditionShowCompInfo cenv = do
st <- readCBMVar $ mcs $ view cenv
- bf1 <- textViewGetBuffer <=< textview1 $ uiBuilder $ view cenv
- bf2 <- textViewGetBuffer <=< textview2 $ uiBuilder $ view cenv
-
- ei <- getElemInfo (selection (fst4 st)) (snd4 st)
- case ei of
- Nothing -> return ()
- Just (ni,nt) -> do textBufferSetText bf1 ni
- textBufferSetText bf2 nt
- where fst4 (a,_,_,_) = a
- snd4 (_,b,_,_) = b
-
--- | Updates a text buffer only if it's necessary (to avoid extra events)
-textBufferUpdateText :: TextBuffer -> String -> IO ()
-textBufferUpdateText bf s = do
- tx <- textBufferGetAllText bf
- when (tx /= s) $ textBufferSetText bf s
-
--- | Gets all the text from a text buffer
-textBufferGetAllText :: TextBuffer -> IO String
-textBufferGetAllText bf = do
- si <- textBufferGetStartIter bf
- ei <- textBufferGetEndIter bf
- textBufferGetText bf si ei True
-
-getElemInfo :: [Name] -> S.SimState -> IO (Maybe (String, String))
+ bf1 <- textViewGetBuffer <=< infoTextView $ uiBuilder $ view cenv
+ bf2 <- textViewGetBuffer <=< traceTextView $ uiBuilder $ view cenv
+
+ let sel = selection (fst4 st)
+ simSt = snd4 st
+
+ awhenM (getElemInfo sel simSt) $ \(ni,nt) -> do
+ textBufferUpdateText bf1 ni
+ textBufferUpdateText bf2 nt
+
+-- | Renders the info relative to a given element (both basic info and a trace)
+getElemInfo :: [Name] -- ^ The qualified name of the element whose info we need
+ -> S.SimState -- ^ The current SimState
+ -> IO (Maybe (String, String)) -- ^ If the element exists, it's associated info, and
+ -- Nothing otherwise
getElemInfo [x] ss = getNodeInfo x ss
getElemInfo [x,y] ss = getCompInfo x y ss
getElemInfo _ _ = return Nothing
-- | Gets the node info
getNodeInfo :: Name -> S.SimState -> IO (Maybe (String, String))
-getNodeInfo n ss = return $ do
- (_,e) <- find ((n ==) . show . S.nodeId . snd) ns
- let binfo = unlines ["Node: " ++ show (S.nodeId e)]
- return (binfo, "Traces are only available for components")
- where ns = I.toList $ S.nodes ss
+getNodeInfo n _ss = return $ do
+ -- (_,e) <- find ((n ==) . show . S.nodeId . snd) ns
+ let binfo = "Node: " ++ n
+ tinfo = "Traces are only available for components"
+ return (binfo, tinfo)
+ -- where ns = I.toList $ S.nodes ss
-- | Compiles the component info
getCompInfo :: Name -> Name -> S.SimState -> IO (Maybe (String, String))
-getCompInfo nn cn ss = do
- let ctx = getCompCtx nn cn ss
- case ctx of
- Nothing -> return Nothing
- Just ctx' -> fmap Just $ showCompInfo nn cn ss ctx'
+getCompInfo nn cn ss =
+ maybe (return Nothing) (fmap Just . showCompInfo nn cn ss) ctx
+ where ctx = getCompCtx nn cn ss
-- | Gets the component context for a given node+name combination
getCompCtx :: Name -> Name -> S.SimState -> Maybe S.ComponentContext
getCompCtx nn cn ss = do
+
+ -- Find node by name
(_,e) <- find ((nn ==) . show . S.nodeId . snd) ns
+
+ -- Find component in node by name
(_,c) <- find ((cn ==) . show . S.componentId . snd) $ I.toList $ S.nodeComponents e
+
+ -- Return component
return c
where ns = I.toList $ S.nodes ss
-- | Renders two strings with the basic component info and the trace
showCompInfo :: Name -> Name -> S.SimState -> S.ComponentContext -> IO (String, String)
-showCompInfo nn cn ss cc@(S.CC cid csu cse cr buf trc smd) = do
+showCompInfo nn cn ss cc = do
bi <- showCompBasicInfo nn cn ss cc
msg <- showCompTrace nn cn ss cc
return (bi, msg)
-- | Creates a string with the basic component info for a given S.ComponentContext
showCompBasicInfo :: Name -> Name -> S.SimState -> S.ComponentContext -> IO String
-showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
+showCompBasicInfo nn cn _ss (S.CC _cid csu cse _cr _buf _trc smd) = do
metaData <- readTVarIO smd
cKind <- fmap S.componentName $ readTVarIO cse
cStatus <- readTVarIO csu
@@ -105,8 +100,9 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
S.WaitingForMsg sid _ -> "Waiting for message from " ++ show sid
return $ unlines
- [ "Component pid: " ++ show cid
+ [ "Component pid: " ++ cn
, "Component kind: " ++ cKind
+ , "Node: " ++ nn
, "Component status: " ++ st
, "Cycles running: " ++ show (S.cyclesRunning metaData)
, "Cycles waiting: " ++ show (S.cyclesWaiting metaData)
@@ -115,5 +111,4 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
-- | Creates a component trace from a given S.ComponentContext
showCompTrace :: Name -> Name -> S.SimState -> S.ComponentContext -> IO String
-showCompTrace nn cn ss (S.CC cid csu cse cr buf trc smd) =
- return $ unlines trc
+showCompTrace _nn _cn _ss (S.CC _ _ _ _ _ trc _) = return $ unlines trc
View
18 src/Controller/Conditions/InfoSelectionArea.hs
@@ -6,9 +6,7 @@ module Controller.Conditions.InfoSelectionArea
-- External imports
import Control.Monad
-import Control.Monad.Trans
import Graphics.UI.Gtk
-import Hails.MVC.Model.ProtectedModel.Reactive
-- Local imports
import CombinedEnvironment
@@ -17,16 +15,20 @@ import CombinedEnvironment
-- chooses between basic info and component trace
installHandlers :: CEnv -> IO()
installHandlers cenv = void $ do
- iv <- iconview1 $ uiBuilder $ view cenv
+ iv <- infoIconView $ uiBuilder $ view cenv
iv `on` selectionChanged $ condition cenv
model cenv `onEvent` Initialised $ condition cenv
-- | Shows appropriate page based on current selection
condition :: CEnv -> IO()
condition cenv = do
- iv <- iconview1 $ uiBuilder $ view cenv
- nb <- notebook3 $ uiBuilder $ view cenv
+ iv <- infoIconView ui
+ nb <- infoSelNotebook ui
(path, _) <- iconViewGetCursor iv
- case path of
- [x] -> notebookSetCurrentPage nb (x + 1)
- _ -> notebookSetCurrentPage nb 0
+ let page = case path of { [x] -> x + 1; _ -> 0 }
+
+ notebookSetCurrentPage nb page
+ -- case path of
+ -- [x] -> notebookSetCurrentPage nb (x + 1)
+ -- _ -> notebookSetCurrentPage nb 0
+ where ui = uiBuilder $ view cenv
View
49 src/Controller/Conditions/InfoTooltip.hs
@@ -4,58 +4,61 @@ module Controller.Conditions.InfoTooltip
where
-- External imports
-import Control.Concurrent.STM
-import Control.Monad
-import Data.CBMVar
-import Data.List
-import Data.Maybe
-import Graphics.UI.Gtk
-import qualified Data.IntMap as I
-import qualified SoOSiM.Types as S
-import Unique
+import Control.Concurrent.STM
+import Control.Monad
+import Data.CBMVar
+import qualified Data.IntMap as I
+import Data.List
+import Data.Maybe
+import Data.Tuple4
+import Graphics.UI.Gtk
+import qualified SoOSiM.Types as S
-- Internal imports
import CombinedEnvironment
-import Graphics.Diagrams.MultiCoreStatus
import Graphics.Diagrams.Types
-- | Handles changes in the box selection in the gloss diagram
installHandlers :: CEnv -> IO()
-installHandlers cenv = void $ do
+installHandlers cenv = void $
installCallbackCBMVar mcsRef $ conditionShowPage cenv
where mcsRef = mcs (view cenv)
-- | Shows component info only when a component is selected
conditionShowPage :: CEnv -> IO()
conditionShowPage cenv = do
- st <- readCBMVar $ mcs $ view cenv
- let sel = fth4 st
- tt <- getElemInfo sel (snd4 st)
- lbl <- label12 $ uiBuilder $ view cenv
+ -- Get elem info if possible
+ st <- readCBMVar $ mcs $ view cenv
+ tt <- getElemInfo (fth4 st) (snd4 st)
- let txt = map (\x -> if x == '\n' then ' ' else x) $ fromMaybe "" tt
- labelSetText lbl txt
-
- where fth4 (a,b,c,d) = d
- snd4 (a,b,c,d) = b
+ -- Update label text
+ lbl <- statusLbl $ uiBuilder $ view cenv
+ labelSetText lbl $ fromMaybe "" tt
+-- | Gets the summarised info from components only
getElemInfo :: [Name] -> S.SimState -> IO (Maybe String)
getElemInfo [x,y] ss = getCompInfo x y ss
getElemInfo _ _ = return Nothing
-- | Compiles the component info
getCompInfo :: Name -> Name -> S.SimState -> IO (Maybe String)
-getCompInfo nn cn ss = do
- let ctx = getCompCtx nn cn ss
+getCompInfo nn cn ss =
case ctx of
Nothing -> return Nothing
Just ctx' -> fmap Just $ showCompBasicInfo nn cn ss ctx'
+ where ctx = getCompCtx nn cn ss
-- | Gets the component context for a given node+name combination
getCompCtx :: Name -> Name -> S.SimState -> Maybe S.ComponentContext
getCompCtx nn cn ss = do
+
+ -- Find node by name
(_,e) <- find ((nn ==) . show . S.nodeId . snd) ns
+
+ -- Find component in node by name
(_,c) <- find ((cn ==) . show . S.componentId . snd) $ I.toList $ S.nodeComponents e
+
+ -- Return component
return c
where ns = I.toList $ S.nodes ss
@@ -71,7 +74,7 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
S.Running -> "Running"
S.WaitingForMsg _ _ -> "Waiting"
- return $ unlines
+ return $ map (\x -> if x == '\n' then ' ' else x) $ unlines
[ show cid
, ": " ++ cKind
, "| " ++ st
View
2  src/Controller/Conditions/Selection.hs
@@ -6,6 +6,7 @@ module Controller.Conditions.Selection
-- External imports
import Control.Monad
import Data.CBMVar
+import Data.Tuple4
import Graphics.UI.Gtk
-- Internal imports
@@ -27,4 +28,3 @@ conditionShowPage cenv = do
case sel of
[] -> notebookSetCurrentPage nb 0
_ -> notebookSetCurrentPage nb 1
- where fst4 (a,b,c,d) = a
View
19 src/Graphics/UI/Gtk/Multiline/TextBufferHelpers.hs
@@ -0,0 +1,19 @@
+-- | Auxiliary functions userful to manipulate TextBuffers
+module Graphics.UI.Gtk.Multiline.TextBufferHelpers where
+
+-- External imports
+import Control.Monad
+import Graphics.UI.Gtk
+
+-- | Updates a text buffer only if it's necessary (to avoid extra events)
+textBufferUpdateText :: TextBuffer -> String -> IO ()
+textBufferUpdateText bf s = do
+ tx <- textBufferGetAllText bf True
+ when (tx /= s) $ textBufferSetText bf s
+
+-- | Gets all the text from a text buffer
+textBufferGetAllText :: TextBuffer -> Bool -> IO String
+textBufferGetAllText bf hidden = do
+ si <- textBufferGetStartIter bf
+ ei <- textBufferGetEndIter bf
+ textBufferGetText bf si ei hidden
View
16 src/View/InitAnimationArea.hs
@@ -12,9 +12,10 @@ import "gloss-gtk" Graphics.Gloss.Interface.IO.Animate
import Graphics.UI.Gtk hiding (Color, Point, Size, LeftButton, RightButton)
-- Local imports
-import View.Objects
-import SoOSiM.Types
import Config.Config
+import Data.Tuple4
+import SoOSiM.Types
+import View.Objects
-- Local imports: basic types
import Graphics.Diagrams.MultiCoreStatus
@@ -41,7 +42,7 @@ initialViewState = (0.5, (-400, -100))
initialiseAnimationArea :: Config -> SimGlVar -> Builder -> IO ()
initialiseAnimationArea cfg mcs bldr = do
vp <- viewport1 bldr
- ev <- eventbox1 bldr
+ ev <- overviewEventBox bldr
-- Paint thumbnail inside eventbox with the viewport size for reference
drawThumb cfg mcs ev vp
@@ -278,12 +279,3 @@ isAreaOf p1@(p11, p12) d@((p21, p22), (w,h)) =
-- dimensions)
unScale :: Float -> Point -> Point
unScale progScale p = multPos p (1 / progScale, 1 / progScale)
-
-fst4 :: (a,b,c,d) -> a
-fst4 (a,_,_,_) = a
-
-snd4 :: (a,b,c,d) -> b
-snd4 (_,b,_,_) = b
-
-trd4 :: (a,b,c,d) -> c
-trd4 (_,_,c,_) = c
View
11 src/View/InitIconsInfoArea.hs
@@ -1,3 +1,4 @@
+-- | Loads the icons into the component info icon view
module View.InitIconsInfoArea where
-- External libraries
@@ -9,11 +10,12 @@ import Paths
type IconsInfoViewStore = ListStore (Pixbuf, String)
+-- | Loads the icons into the component info icon view
initIconsInfoArea :: Builder -> IO IconsInfoViewStore
initIconsInfoArea bldr = do
m <- listStoreNew =<< getIconList
- iv <- iconview1 bldr
+ iv <- infoIconView bldr
iconViewSetModel iv (Just m)
@@ -35,18 +37,21 @@ initIconsInfoArea bldr = do
return m
+-- | The pixbuf column
_PIXBUF_COLUMN :: ColumnId (Pixbuf, String) Pixbuf
_PIXBUF_COLUMN = makeColumnIdPixbuf 0
+-- | The string column
_STRING_COLUMN :: ColumnId (Pixbuf, String) String
_STRING_COLUMN = makeColumnIdString 1
-
+-- | The icon list with proper sizes
getIconList :: IO [(Pixbuf, String)]
getIconList = mapM f icons
where f (x,y) = getDataFileName x >>= \w -> pixbufNewFromFileAtSize w 48 48 >>= \pb -> return (pb, y)
+-- | The list of icons and their labels
icons :: [(String, String)]
-icons = [ ("images/icons/info.png", "Basic info")
+icons = [ ("images/icons/info.png", "Basic info")
, ("images/icons/trace.png", "Trace")
]
View
12 src/View/Objects.hs
@@ -34,9 +34,9 @@ gtkBuilderAccessor "hscale1" "HScale"
gtkBuilderAccessor "vpaned1" "VPaned"
gtkBuilderAccessor "notebook1" "Notebook"
gtkBuilderAccessor "notebook2" "Notebook"
-gtkBuilderAccessor "notebook3" "Notebook"
-gtkBuilderAccessor "eventbox1" "EventBox"
-gtkBuilderAccessor "iconview1" "IconView"
-gtkBuilderAccessor "textview1" "TextView"
-gtkBuilderAccessor "textview2" "TextView"
-gtkBuilderAccessor "label12" "Label"
+gtkBuilderAccessor "infoSelNotebook" "Notebook"
+gtkBuilderAccessor "overviewEventBox" "EventBox"
+gtkBuilderAccessor "infoIconView" "IconView"
+gtkBuilderAccessor "infoTextView" "TextView"
+gtkBuilderAccessor "traceTextView" "TextView"
+gtkBuilderAccessor "statusLbl" "Label"
Please sign in to comment.
Something went wrong with that request. Please try again.