Chart-gtk3 (empty) → 1.9.3

raw patch · 4 files changed

+172/−0 lines, 4 filesdep +Chartdep +Chart-cairodep +arraysetup-changed

Dependencies added: Chart, Chart-cairo, array, base, cairo, colour, data-default-class, gtk3, mtl, old-locale, time

Files

Chart-gtk3.cabal +31/−0
Graphics/Rendering/Chart/Gtk.hs +102/−0
LICENSE +31/−0
Setup.hs +8/−0

+ Chart-gtk3.cabal view

@@ -0,0 +1,31 @@+Name: Chart-gtk3+Version: 1.9.3+License: BSD3+License-file: LICENSE+Copyright: Tim Docker, 2006-2014+Author: Tim Docker <tim@dockerz.net>+Maintainer: Tim Docker <tim@dockerz.net>+Homepage: https://github.com/timbod7/haskell-chart/wiki+Synopsis: Utility functions for using the chart library with GTK+Description: Utility functions for using the chart library with GTK+Category: Graphics+Cabal-Version: >= 1.6+Build-Type: Simple++library+  Build-depends: base >= 3 && < 5+               , old-locale+               , time, mtl, array+               , cairo >= 0.9.11+               , data-default-class < 0.2+               , colour >= 2.2.1 && < 2.4+               , gtk3 >= 0.14+               , Chart >= 1.9 && < 1.10+               , Chart-cairo >= 1.9 && < 1.10++  Exposed-modules:+        Graphics.Rendering.Chart.Gtk++source-repository head+  type:     git+  location: https://github.com/timbod7/haskell-chart

+ Graphics/Rendering/Chart/Gtk.hs view

@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Gtk+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Gtk (+    renderableToWindow,+    toWindow,+    createRenderableWindow,+    updateCanvas+    ) where++import qualified Graphics.UI.Gtk as G+import qualified Graphics.UI.Gtk.Gdk.Events as GE+import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Backend.Cairo+import Graphics.Rendering.Chart.State(EC, execEC)++import Data.List (isPrefixOf)+import Data.IORef+import Data.Default.Class++import Control.Monad(when)+import System.IO.Unsafe(unsafePerformIO)+++-- Yuck. But we really want the convenience function+-- renderableToWindow as to be callable without requiring+-- initGUI to be called first. But newer versions of+-- gtk insist that initGUI is only called once+guiInitVar :: IORef Bool+{-# NOINLINE guiInitVar #-}+guiInitVar = unsafePerformIO (newIORef False)++initGuiOnce :: IO ()+initGuiOnce = do+    v <- readIORef guiInitVar+    when (not v) $ do+        -- G.initGUI+        G.unsafeInitGUIForThreadedRTS+        writeIORef guiInitVar True++-- | Display a renderable in a gtk window.+--+-- Note that this is a convenience function that initialises GTK on+-- its first call, but not subsequent calls. Hence it's +-- unlikely to be compatible with other code using gtk. In +-- that case use createRenderableWindow.+renderableToWindow :: Renderable a -> Int -> Int -> IO ()+renderableToWindow chart windowWidth windowHeight = do+    initGuiOnce+    window <- createRenderableWindow chart windowWidth windowHeight+    -- press any key to exit the loop+    window `G.on` G.keyPressEvent $ do+                     C.liftIO (G.widgetDestroy window)+                     return True+    window `G.on` G.objectDestroy $ G.mainQuit+    G.widgetShowAll window+    G.mainGUI++-- | Generate a new GTK window from the state content of+-- an EC computation. The state may have any type that is+-- an instance of `ToRenderable`+toWindow :: (Default r, ToRenderable r) =>Int -> Int -> EC r () -> IO ()+toWindow windowWidth windowHeight ec = renderableToWindow r windowWidth windowHeight where+                       r = toRenderable (execEC ec)++-- | Create a new GTK window displaying a renderable.+createRenderableWindow :: Renderable a -> Int -> Int -> IO G.Window+createRenderableWindow chart windowWidth windowHeight = do+    window <- G.windowNew+    canvas <- G.drawingAreaNew+    G.widgetSetSizeRequest window windowWidth windowHeight+    canvas `G.on` G.draw $ do+      C.liftIO $ updateCanvas chart canvas+      return ()++    G.set window [G.containerChild G.:= canvas]+    return window+++updateCanvas :: Renderable a -> G.DrawingArea  -> IO Bool+updateCanvas chart canvas = do+    mwin <- G.widgetGetWindow canvas+    case mwin of+      Nothing -> return False+      Just win -> do+        width  <- C.liftIO $ G.widgetGetAllocatedWidth canvas+        height <- C.liftIO $ G.widgetGetAllocatedHeight canvas+        let rect = GE.Rectangle 0 0 width height+        let sz   = (fromIntegral width, fromIntegral height)+        G.drawWindowBeginPaintRect win rect+        G.renderWithDrawWindow win+          $ runBackend (defaultEnv bitmapAlignmentFns) (render chart sz)+        G.drawWindowEndPaint win+        return True

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2006, Tim Docker++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain