Периодически повторяющееся задание в haskell и GTK - PullRequest
0 голосов
/ 25 сентября 2018

Я новичок в haskell и хотел бы написать графический интерфейс с помощью gtk.Цель программы - периодически опрашивать интерфейс UART (который уже работает) и обновлять значения графика.Я использую библиотеку "Диаграмма".Я уже зашел так далеко, что нарисовал одну диаграмму в окне.Сейчас я использую «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, часто задаваемые вопросы GTK + в http://library.gnome.org/devel/gtk-faq/stable/объясняет, как перерисовать виджет

Я не знаю, что за указатель Magic Haskell делает под капотом.И кажется, что мне придется использовать «навсегда» с какой-то задержкой?Существует ли стандартная процедура для периодических вызовов с временной задержкой?

Текущий код:

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

Я использую новейшую версию стека со следующими дополнительными значениями deps в 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

1 Ответ

0 голосов
/ 03 октября 2018

У вас есть

G.set window [G.containerChild G.:= canvas]

как в createWindowAndCanvas, так и в main, и предупреждение дает вам понять, что canvas не следует делать дочерним элементом контейнера, когда он ужедочерний элемент контейнера.

Вы можете решить проблему, удалив один или другой дочерний объект.

...