----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Gtk.UI -- Copyright : (c) Sumit Sahrawat -- License : GPL-2 -- -- Maintainer : sumit.sahrawat.apm13@iitbhu.ac.in -- Stability : provisional -- Portability : portable -- -- Figure to be displayed on errors -- -------------------------------------------------------------------------------- module Graphics.Rendering.Plot.Gtk.UI.ErrorFig (errorFig) where -------------------------------------------------------------------------------- -- Standard Libraries import Control.Monad (forM_) -------------------------------------------------------------------------------- -- Other Libraries import Graphics.Rendering.Cairo hiding (x, y) -------------------------------------------------------------------------------- -- Custom Modules import Graphics.Rendering.Plot.Gtk.UI.Settings (FigureSettings (..)) -------------------------------------------------------------------------------- errorFig :: FigureSettings -> (Int, Int) -> Render () errorFig fset (w', h') = do -- Fill with red save let [w, h] = map fromIntegral [w', h'] setSourceRGBA 0.0 0.0 0.0 0.5 rectangle 0 0 w h fill restore -- Make a box save let [a, b] = map (/8) [w, h] setSourceRGBA 0.0 0.0 0.0 0.2 setLineWidth 5 roundRectangle a (2 * b) (6 * a) (4 * b) fill restore -- The text let msgs = getErrors fset -- Draw text save setSourceRGBA 0.0 0.0 0.0 0.3 setFontSize 30 setSourceRGBA 1.0 1.0 1.0 0.7 selectFontFace "sans" FontSlantNormal FontWeightBold let ms = zip msgs [0 ..] forM_ ms $ \(m, i) -> do (TextExtents _ _ tw th _ _) <- textExtents m moveTo (4 * a - tw / 2) ((2.5 + i) * b + th / 2) showText m restore -------------------------------------------------------------------------------- getErrors :: FigureSettings -> [String] getErrors fset = prepare [ "~~ Error(s) ~~" , let Just (xl, xu) = xRange fset in if xu <= xl then "Invalid X-Range" else "" , case yRange fset of Nothing -> "Unrealistic Y-Range" Just (yl, yu) -> if yu <= yl then "Invalid Y-Range" else "" ] where prepare xs = if not . null $ xs then xs else [ "The gray screen" , "of no plots :)" ] -- [ "Check ranges on right" -- , "and sliders above" ] -------------------------------------------------------------------------------- roundRectangle :: Double -> Double -> Double -> Double -> Render () roundRectangle x y w h = do let r = h / 10 arc (x + w - r) (y + r) r (-pi/2) 0 arc (x + w - r) (y + h - r) r 0 ( pi/2) arc (x + r) (y + h - r) r (pi/2) pi arc (x + r) (y + r) r pi (3*pi/2) closePath --------------------------------------------------------------------------------