在 haskell 和 GTK 中定期重复任务
Periodically repeating task in haskell and GTK
我对 haskell 很陌生,想用 gtk 编写一个 GUI。
该程序的目标是定期轮询 UART 接口(已经工作),
并更新图表的值。我使用 "Chart" 库。
我已经达到了在 window 中绘制单个图表的程度。
现在我目前使用 "G.timeoutAdd" http://hackage.haskell.org/package/gtk-0.15.0/docs/Graphics-UI-Gtk-General-General.html,我将绘制一些值的函数传递给它。
然后我收到以下 GTK 警告:
(:24592): Gtk-WARNING **: 12:06:59.996: 试图将 GtkDrawingArea 类型的小部件添加到 GtkWindow 类型的容器中,但该小部件已经在 GtkWindow 类型的容器中,位于 http://library.gnome.org/devel/gtk-faq/stable/ 的 GTK+ 常见问题解答解释了如何重新设置小部件的父级
我不知道 Magic Haskell 背后有什么样的指针。
看来,我必须使用带有某种延迟的 "forever" 吗?
有延时调用的标准程序吗?
当前代码:
module Main where
import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Gtk
import qualified Graphics.UI.Gtk as G
import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.UI.Gtk.Gdk.Events as GE
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Backend.Cairo
import Data.IORef
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
linechart list = toRenderable layout
where
lineplot = plot_lines_values .~ list
$ plot_lines_style . line_color .~ opaque blue
$ plot_lines_title .~ "Plot"
$ def
layout = layout_title .~ "Amplitude Modulation"
$ layout_plots .~ [toPlot lineplot]
$ def
func :: Double -> Double
func x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))
createWindowAndCanvas :: Renderable a -> Int -> Int -> IO (G.Window, G.DrawingArea)
createWindowAndCanvas chart windowWidth windowHeight = do
window <- G.windowNew
canvas <- G.drawingAreaNew
G.widgetSetSizeRequest window windowWidth windowHeight
G.onExpose canvas $ const (updateCanvas chart canvas)
G.set window [G.containerChild G.:= canvas]
return (window, canvas)
getSerialDataAndUpdateCanvas :: G.DrawingArea ->IO(Bool)
getSerialDataAndUpdateCanvas canvas = do
-- I Thought that here, i could do the fetching of the data from
-- the UART/Serialport and then give the data to "x"
umpdateCanvas (linechart [[ (x, func x) | x <- [0,0.5 .. 40.0 ]]]) canvas
return True
umpdateCanvas :: Renderable a -> G.DrawingArea -> IO Bool
umpdateCanvas chart canvas = do
win <- G.widgetGetDrawWindow canvas
(width, height) <- G.widgetGetSize canvas
regio <- G.regionRectangle $ GE.Rectangle 0 0 width height
let sz = (fromIntegral width, fromIntegral height)
G.drawWindowBeginPaintRegion win regio
G.renderWithDrawable win $ runBackend (defaultEnv bitmapAlignmentFns) (render chart sz)
G.drawWindowEndPaint win
return True
main :: IO ()
main = do
let emptyList = [[]] :: [[(Double, Double)]]
emptyChart = linechart emptyList
initGuiOnce
(window, canvas) <- createWindowAndCanvas emptyChart 400 400
G.set window [G.containerChild G.:= canvas]
window `G.on` G.keyPressEvent $ do
C.liftIO (G.widgetDestroy window)
return True
window `G.on` G.objectDestroy $ G.mainQuit
-- Calls function with the timeout in ms
G.timeoutAdd (getSerialDataAndUpdateCanvas canvas) 20
G.widgetShowAll window
G.mainGUI
我使用最新版本的堆栈,在 stack.yaml
中有以下额外的依赖
extra-deps:
- gtk-0.14.10
- gio-0.13.5.0
- SVGFonts-1.6.0.3
- diagrams-core-1.4.1.1
- diagrams-lib-1.4.2.3
- diagrams-postscript-1.4.1
- diagrams-svg-1.4.2
- diagrams-solve-0.1.1
- dual-tree-0.2.2
- Chart-1.9
- Chart-cairo-1.9
- Chart-diagrams-1.9
- Chart-gtk-1.9
和 package.yaml
中的依赖项
dependencies:
- base >= 4.7 && < 5
- gtk
- Chart
- cairo
- Chart-diagrams
- Chart-gtk
- Chart-cairo
你有
G.set window [G.containerChild G.:= canvas]
在 createWindowAndCanvas
和 main
中,警告是让您知道 canvas
已经是容器的子容器时,不应将其设为容器的子容器一个容器。
您可以通过删除一个或另一个子关系来解决问题。
我对 haskell 很陌生,想用 gtk 编写一个 GUI。 该程序的目标是定期轮询 UART 接口(已经工作), 并更新图表的值。我使用 "Chart" 库。 我已经达到了在 window 中绘制单个图表的程度。 现在我目前使用 "G.timeoutAdd" http://hackage.haskell.org/package/gtk-0.15.0/docs/Graphics-UI-Gtk-General-General.html,我将绘制一些值的函数传递给它。
然后我收到以下 GTK 警告:
(:24592): Gtk-WARNING **: 12:06:59.996: 试图将 GtkDrawingArea 类型的小部件添加到 GtkWindow 类型的容器中,但该小部件已经在 GtkWindow 类型的容器中,位于 http://library.gnome.org/devel/gtk-faq/stable/ 的 GTK+ 常见问题解答解释了如何重新设置小部件的父级
我不知道 Magic Haskell 背后有什么样的指针。 看来,我必须使用带有某种延迟的 "forever" 吗? 有延时调用的标准程序吗?
当前代码:
module Main where
import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Gtk
import qualified Graphics.UI.Gtk as G
import qualified Graphics.Rendering.Cairo as C
import qualified Graphics.UI.Gtk.Gdk.Events as GE
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Backend.Cairo
import Data.IORef
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
linechart list = toRenderable layout
where
lineplot = plot_lines_values .~ list
$ plot_lines_style . line_color .~ opaque blue
$ plot_lines_title .~ "Plot"
$ def
layout = layout_title .~ "Amplitude Modulation"
$ layout_plots .~ [toPlot lineplot]
$ def
func :: Double -> Double
func x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))
createWindowAndCanvas :: Renderable a -> Int -> Int -> IO (G.Window, G.DrawingArea)
createWindowAndCanvas chart windowWidth windowHeight = do
window <- G.windowNew
canvas <- G.drawingAreaNew
G.widgetSetSizeRequest window windowWidth windowHeight
G.onExpose canvas $ const (updateCanvas chart canvas)
G.set window [G.containerChild G.:= canvas]
return (window, canvas)
getSerialDataAndUpdateCanvas :: G.DrawingArea ->IO(Bool)
getSerialDataAndUpdateCanvas canvas = do
-- I Thought that here, i could do the fetching of the data from
-- the UART/Serialport and then give the data to "x"
umpdateCanvas (linechart [[ (x, func x) | x <- [0,0.5 .. 40.0 ]]]) canvas
return True
umpdateCanvas :: Renderable a -> G.DrawingArea -> IO Bool
umpdateCanvas chart canvas = do
win <- G.widgetGetDrawWindow canvas
(width, height) <- G.widgetGetSize canvas
regio <- G.regionRectangle $ GE.Rectangle 0 0 width height
let sz = (fromIntegral width, fromIntegral height)
G.drawWindowBeginPaintRegion win regio
G.renderWithDrawable win $ runBackend (defaultEnv bitmapAlignmentFns) (render chart sz)
G.drawWindowEndPaint win
return True
main :: IO ()
main = do
let emptyList = [[]] :: [[(Double, Double)]]
emptyChart = linechart emptyList
initGuiOnce
(window, canvas) <- createWindowAndCanvas emptyChart 400 400
G.set window [G.containerChild G.:= canvas]
window `G.on` G.keyPressEvent $ do
C.liftIO (G.widgetDestroy window)
return True
window `G.on` G.objectDestroy $ G.mainQuit
-- Calls function with the timeout in ms
G.timeoutAdd (getSerialDataAndUpdateCanvas canvas) 20
G.widgetShowAll window
G.mainGUI
我使用最新版本的堆栈,在 stack.yaml
中有以下额外的依赖extra-deps:
- gtk-0.14.10
- gio-0.13.5.0
- SVGFonts-1.6.0.3
- diagrams-core-1.4.1.1
- diagrams-lib-1.4.2.3
- diagrams-postscript-1.4.1
- diagrams-svg-1.4.2
- diagrams-solve-0.1.1
- dual-tree-0.2.2
- Chart-1.9
- Chart-cairo-1.9
- Chart-diagrams-1.9
- Chart-gtk-1.9
和 package.yaml
中的依赖项dependencies:
- base >= 4.7 && < 5
- gtk
- Chart
- cairo
- Chart-diagrams
- Chart-gtk
- Chart-cairo
你有
G.set window [G.containerChild G.:= canvas]
在 createWindowAndCanvas
和 main
中,警告是让您知道 canvas
已经是容器的子容器时,不应将其设为容器的子容器一个容器。
您可以通过删除一个或另一个子关系来解决问题。