plot-gtk 0.1.0.11 → 0.2

raw patch · 3 files changed

+73/−39 lines, 3 files

Files

• CHANGES +4/−0
• lib/Graphics/Rendering/Plot/Gtk.hs +67/−37
• plot-gtk.cabal +2/−2

@@ -30,3 +30,7 @@  0.1.0.11: 		* fixed .cabal repository line++0.2:+		* fix window behaviour by initialising once only and counting +                    open windows to know when to quit 

@@ -25,6 +25,7 @@ -----------------------------------------------------------------------------  import Control.Monad.Trans+import Control.Monad  import Control.Concurrent @@ -34,57 +35,86 @@  import Graphics.Rendering.Plot +import System.IO.Unsafe+ -----------------------------------------------------------------------------  data PlotHandle = PH FigureHandle (MVar DrawingArea)  ----------------------------------------------------------------------------- +guiInit :: MVar Bool+{-# NOINLINE guiInit #-}+guiInit = unsafePerformIO (newMVar False)++initGUIOnce :: IO ()+initGUIOnce = do+  init <- readMVar guiInit +  when (not init) $ do+    _ <- forkOS $ runInBoundThread $ do+      _ <- unsafeInitGUIForThreadedRTS+      swapMVar guiInit True+      mainGUI --return ()+    return ()+  return ()++guiNumWindows :: MVar Int+{-# NOINLINE guiNumWindows #-}+guiNumWindows = unsafePerformIO (newMVar 0)++-----------------------------------------------------------------------------+ -- | create a new figure and display the plot --     click on the window to save display :: Figure () -> IO PlotHandle display f = do+   initGUIOnce    fs <- newFigureState f    fig <- newMVar fs    handle <- newEmptyMVar :: IO (MVar DrawingArea)-   _ <- forkOS $ runInBoundThread $ do-                 _ <- initGUI       -- is start-                 ---                 window <- windowNew-                 set window [ windowTitle := "Figure"-                            , windowDefaultWidth := 400-                            , windowDefaultHeight := 300-                            , containerBorderWidth := 1-                            ]-                 ---                 frame <- frameNew-                 containerAdd window frame-                 canvas <- plotNew fig-                 containerAdd frame canvas-                 ---                 putMVar handle canvas-                 ---                 _ <- on canvas buttonPressEvent $ tryEvent $ liftIO $ do -                                     fc <- newPlotSaveDialog-                                     widgetShow fc-                                     rsp <- dialogRun fc-                                     case rsp of-                                       ResponseAccept -> do -                                                Just fn <- fileChooserGetFilename fc-                                                Just ff <- fileChooserGetFilter fc-                                                ffn <- fileFilterGetName ff-                                                let ot = filterNameType ffn-                                                s <- widgetGetSize canvas-                                                fig' <- get canvas figure-                                                writeFigureState ot fn s fig'-                                       ResponseCancel -> return ()-                                     widgetHide fc+   --+   postGUIAsync $ do+     window <- windowNew+     set window [ windowTitle := "Figure"+                , windowDefaultWidth := 400+                , windowDefaultHeight := 300+                , containerBorderWidth := 1+                ]+     --+     frame <- frameNew+     containerAdd window frame+     canvas <- plotNew fig+     containerAdd frame canvas+     --+     putMVar handle canvas+     --+     _ <- on canvas buttonPressEvent $ tryEvent $ liftIO $ do +              fc <- newPlotSaveDialog+              widgetShow fc+              rsp <- dialogRun fc+              case rsp of+                ResponseAccept -> do +                  Just fn <- fileChooserGetFilename fc+                  Just ff <- fileChooserGetFilter fc+                  ffn <- fileFilterGetName ff+                  let ot = filterNameType ffn+                  s <- widgetGetSize canvas+                  fig' <- get canvas figure+                  writeFigureState ot fn s fig'+                ResponseCancel -> return ()+              widgetHide fc -                 widgetShowAll window -                 ---                 _ <- onDestroy window mainQuit-                 ---                 mainGUI+     widgetShowAll window +     --+{-+     _ <- onDestroy window $ do+                    modifyMVar_ guiNumWindows (return . (\x -> x-1))+                    nw <- readMVar guiNumWindows+                    when (nw <= 0) mainQuit+                    return ()+-}+     --+     return () --mainGUI    return $ PH fig handle  -----------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:                plot-gtk-Version:             0.1.0.11+Version:             0.2 License:             BSD3 License-file:        LICENSE Copyright:           (c) A.V.H. McPhail 2010@@ -16,7 +16,7 @@  Category:            Graphics -Tested-with:         GHC==6.12.1+Tested-with:         GHC==7.4.1 Cabal-version:       >= 1.8 Build-type:          Simple