edentv-4.1.0.0: EdenTvBasic.hs
{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.
Copyright (C) 2005-2010 Phillips Universitaet Marburg
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-}
module EdenTvBasic where
import EdenTvType
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk.Gdk.GC
import Numeric
import Data.Tree hiding (drawTree)
import Data.Word
-- adaption of Data.Tree.drawTree for (Tree a)
-- | Neat 2-dimensional drawing of a tree.
drawTree :: Show a => Tree a -> String
drawTree = unlines . drawTree_
drawTree_ :: Show a => Tree a -> [String]
drawTree_ (Node p pts) = show p : drawSubTrees pts
where drawSubTrees [] = []
drawSubTrees [t] =
"|" : shift "`-- " " " (drawTree_ t)
drawSubTrees (t:ts) =
"|" : shift "+-- " "| " (drawTree_ t) ++ drawSubTrees ts
shift first other = zipWith (++) (first : repeat other)
-- some standard colors
-- color___ :: Render ()
colorRedA = setSourceRGBA 0.8 0.0 0.0 0.7
colorGray = setSourceRGB 0.5 0.5 0.5
colorBlack = setSourceRGB 0.0 0.0 0.0
getDefaultColors :: Colors
getDefaultColors = Colors
{ statusRunning = rgb 0 65535 0
, statusSuspended = rgb 65535 65535 0
, statusBlocked = rgb 65535 0 0
, statusIdle = rgb 0 0 65535
, messagesSystem = rgb 41120 0 0
, messagesHead = rgb 6553 6553 6553
, messagesData = rgb 6553 6553 6553
, messagesHeadLocal = rgb 3328 0 47616
, messagesDataLocal = rgb 3328 0 47616
, messagesBlock = rgb 19660 19660 19660
, messagesReceive = rgb 6553 6553 6553
, markerLine = rgba 52428 0 0 45874
, markerLabel = rgba 52428 0 0 45874
, markerStartup = rgba 52428 0 0 45874
, chartBackground = rgb 65535 65535 65535
, chartAxes = rgba 0 0 0 45874
, chartAxesLabel = rgba 0 0 0 45874
}
getDefaultColorsBW :: Colors
getDefaultColorsBW = Colors
{ statusRunning = rgb 39500 39500 39500
, statusSuspended = rgb 59000 59000 59000
, statusBlocked = rgb 19500 19500 19500
, statusIdle = rgb 0 0 0
, messagesSystem = rgb 32767 32767 32767
, messagesHead = rgb 6553 6553 6553
, messagesData = rgb 6553 6553 6553
, messagesHeadLocal = rgb 6553 6553 6553
, messagesDataLocal = rgb 6553 6553 6553
, messagesBlock = rgb 19660 19660 19660
, messagesReceive = rgb 6553 6553 6553
, markerLine = rgba 52428 0 0 45874
, markerLabel = rgba 52428 0 0 45874
, markerStartup = rgba 52428 0 0 45874
, chartBackground = rgb 65535 65535 65535
, chartAxes = rgba 0 0 0 45874
, chartAxesLabel = rgba 0 0 0 45874
}
getColor :: (Colors -> ColorRGBA) -> Colors -> Render ()
getColor getter colors = setSourceRGBA r g b a
where
(r, g, b, a) = getCairoColor $ getter colors
getColorAlpha :: (Colors -> ColorRGBA) -> Colors -> Double -> Render ()
getColorAlpha getter colors alpha = setSourceRGBA r g b alpha
where
(r, g, b, _) = getCairoColor $ getter colors
getCairoColor :: ColorRGBA -> (Double, Double, Double, Double)
getCairoColor (RGBA (Color r g b) a) = (toCairo r, toCairo g, toCairo b, toCairo a)
where
-- Converts a GTK color value (0 - 65535) to a Cairo
-- color value (0 - 1).
toCairo :: Word16 -> Double
toCairo val = (fromIntegral val) / 65535
type ColorGetter = Colors -> ColorRGBA
type ColorSetter = ColorRGBA -> Colors -> Colors
type ColorMapping = (String, ColorGetter, ColorSetter)
-- Maps the color buttons in the "Set Color" - dialog to the color values
-- in the state (`EdenTvState`).
colorMapping :: [ColorMapping]
colorMapping =
[ ("btnStatusRunning", statusRunning, \ color colors -> colors {statusRunning = color})
, ("btnStatusSuspended", statusSuspended, \ color colors -> colors {statusSuspended = color})
, ("btnStatusBlocked", statusBlocked, \ color colors -> colors {statusBlocked = color})
, ("btnStatusIdle", statusIdle, \ color colors -> colors {statusIdle = color})
, ("btnMessagesSystem", messagesSystem, \ color colors -> colors {messagesSystem = color})
, ("btnMessagesHead", messagesHead, \ color colors -> colors {messagesHead = color})
, ("btnMessagesData", messagesData, \ color colors -> colors {messagesData = color})
, ("btnMessagesBlock", messagesBlock, \ color colors -> colors {messagesBlock = color})
, ("btnMessagesReceive", messagesReceive, \ color colors -> colors {messagesReceive = color})
, ("btnMarkerLine", markerLine, \ color colors -> colors {markerLine = color})
, ("btnMarkerLabel", markerLabel, \ color colors -> colors {markerLabel = color})
, ("btnMarkerStartup", markerStartup, \ color colors -> colors {markerStartup = color})
, ("btnChartBackground", chartBackground, \ color colors -> colors {chartBackground = color})
, ("btnChartAxes", chartAxes, \ color colors -> colors {chartAxes = color})
, ("btnAxesLabel", chartAxesLabel, \ color colors -> colors {chartAxesLabel = color})
]
-- ScreenSetup:
border, shadow :: Double
border = 5
shadow = 3
-- getStartTime : gap between local and global starttime of machine i
-- perhaps: use assoziative array / hashtable
getStartTime :: MachineID -> [(MachineID,Double)] -> Double
getStartTime _ [] = 0.0 -- machine not found?
getStartTime i ((m,t):ts)
| m == i = t
| otherwise = getStartTime i ts
posToTime :: Seconds -> Seconds -> Double -> Double -> Double -> Seconds
posToTime minT maxT ulx lrx x = ((x - ulx) * (maxT - minT) / (lrx - ulx))
timeToPos :: Seconds -> Seconds -> Double -> Double -> Seconds -> Double
timeToPos minT maxT ulx lrx y = ((y * (lrx - ulx)) / (maxT-minT) + ulx)
formatFloat :: RealFloat a => a -> String
formatFloat d = showFFloat (Just 6) d ""
switch :: Eq a => a -> a -> [a] -> [a]
{-switch m n matrix = switch' matrix
where
switch' (d:ds)
| d == m = n : switch' ds
| d == n = m : switch' ds
| otherwise = d : switch' ds
switch' _ = []
-}
-- faster switch (old one in O(2n), this one in O(n)):
switch m n (d:ds)
| d == m = n : switch' n m ds
| d == n = m : switch' m n ds
| otherwise = d : switch m n ds
where switch' o p (e:es)
| e == o = p : es
| otherwise = e : switch' o p es
-- switch' _ _ [] = []