{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs. Copyright (C) 2005-2012 Philipps 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' _ _ [] = []