haskell & gtk : "widgetGetDrawWindow: no DrawWindow available"

Question

我有一个小程序可以用来绘制 mandelbrot 集，但是我得到了这个错误：

user error (widgetGetDrawWindow: no DrawWindow available (the widget is probably not realized))

程序： - 初始化图形的东西， - 计算要显示的点， - 绘制这些点

没有语法和编译错误，当我启动二进制文件时显示上述错误。

代码如下：

module Main where

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Windows.Window
import Graphics.UI.Gtk.Misc.DrawingArea
import System.Random
import           Control.Monad            (when,void)


k :: Int
k=100 -- 100 : after launching, u must wait less than 10s

mandelbrot :: Double -> Double -> Bool
mandelbrot a b =
  let
    mandelrec :: Double -> Double -> Int -> Bool
    mandelrec x y i
      | (x * x + y * y > 4) = False
      | (i==k) && (x * x + y * y <= 4) = True
      | otherwise = mandelrec x' y' (i+1)
            where x' = x * x - y * y + a
                  y' = 2 * x * y + b
  in mandelrec 0 0 0

colonnes :: Double -> [(Int, Double)]
colonnes w = [ (t,(fromIntegral t)/w*4-2) | t<-[0..((floor w)-1)] ]

lignes :: Double -> [(Int, Double)]
lignes h = [ (t,(fromIntegral t)/h*4-2) | t<-[0..((floor h)-1)] ]

points :: Double -> Double -> [((Int, Double), (Int, Double))]
points w h = [ (colonne,ligne)| colonne <- colonnes w,ligne <- lignes h]


main :: IO ()
main = do
  putStrLn "Hello World"
  initGUI
  win <- windowNew
  onDestroy win mainQuit
  dAre <- drawingAreaNew
  dAre `onSizeRequest` return (Requisition 500 300)
  dAre `onExpose` drawCanvas dAre
  win `containerAdd` dAre

  --drawWin <- widgetGetDrawWindow dAre
  --drawWindowClear drawWin

  mapM_ (affiche dAre) ( points 500 300)


  widgetShowAll win
  mainGUI

affiche2 :: DrawingArea -> Int -> Int -> IO Bool
affiche2 can a b = do
  drawWin <- widgetGetDrawWindow can
  gece <- gcNew drawWin
  drawLine drawWin gece (a,b) (a,b)
  widgetQueueDraw can
  return True

affiche :: DrawingArea -> ((Int,Double), (Int,Double)) -> IO()
affiche can ((a0,a), (b0,b)) =
  when (mandelbrot a b) $ void (affiche2 can a0 b0)

drawCanvas :: DrawingArea -> event -> IO Bool
drawCanvas can _evt = do
  drawWin <- widgetGetDrawWindow can
  drawWindowClear drawWin
  gece <- gcNew drawWin
  x1 <- randomRIO (0,500)
  x2 <- randomRIO (0,500)
  y1 <- randomRIO (0,300)
  y2 <- randomRIO (0,300)
  drawLine drawWin gece (x1,y1) (x2,y2)
  widgetQueueDraw can
  --drawLine drawWin gece (10,10) (100,100)
  return True

Answer 1

好吧，我通过将 mapM_ 语句放入 updateCanvas 函数来解决它，但是所有的绘图都是在计算完所有点后显示的，这不是我想要获得的：因为更小的部分mandelbrot集，计算的时间越长，我想看到它创建的图，不要等待很长时间。

你知道如何实现这个目标吗？

这是工作代码：

module Main where

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Windows.Window
import Graphics.UI.Gtk.Misc.DrawingArea
import System.Random
import           Control.Monad            (when,void)


k :: Int
k=10000 -- 100 : after launching, u must wait less than 10s

mandelbrot :: Double -> Double -> Bool
mandelbrot a b =
  let
    mandelrec :: Double -> Double -> Int -> Bool
    mandelrec x y i
      | (x * x + y * y > 4) = False
      | (i==k) && (x * x + y * y <= 4) = True
      | otherwise = mandelrec x' y' (i+1)
            where x' = x * x - y * y + a
                  y' = 2 * x * y + b
  in mandelrec 0 0 0

colonnes :: Double -> [(Int, Double)]
colonnes w = [ (t,(fromIntegral t)/w*4-2) | t<-[0..((floor w)-1)] ]

lignes :: Double -> [(Int, Double)]
lignes h = [ (t,(fromIntegral t)/h*4-2) | t<-[0..((floor h)-1)] ]

points :: Double -> Double -> [((Int, Double), (Int, Double))]
points w h = [ (colonne,ligne)| colonne <- colonnes w,ligne <- lignes h]


main :: IO ()
main = do
  putStrLn "Hello World"
  initGUI
  win <- windowNew
  onDestroy win mainQuit
  dAre <- drawingAreaNew
  dAre `onSizeRequest` return (Requisition 500 300)
  dAre `onExpose` drawCanvas dAre
  win `containerAdd` dAre

  --drawWin <- widgetGetDrawWindow dAre
  --drawWindowClear drawWin

  --mapM_ (affiche dAre) ( points 500 300)


  widgetShowAll win
  mainGUI

affiche2 :: DrawingArea -> Int -> Int -> IO Bool
affiche2 can a b = do
  drawWin <- widgetGetDrawWindow can
  gece <- gcNew drawWin
  drawLine drawWin gece (a,b) (a,b)
  --drawLine drawWin gece (10,10) (100,100)
  widgetQueueDraw can
  return True

affiche :: DrawingArea -> ((Int,Double), (Int,Double)) -> IO()
affiche can ((a0,a), (b0,b)) =
  when (mandelbrot a b) $ void (affiche2 can a0 b0)

drawCanvas :: DrawingArea -> event -> IO Bool
drawCanvas can _evt = do
  drawWin <- widgetGetDrawWindow can
  drawWindowClear drawWin
  gece <- gcNew drawWin
  --x1 <- randomRIO (0,500)
  --x2 <- randomRIO (0,500)
  --y1 <- randomRIO (0,300)
  --y2 <- randomRIO (0,300)
  --drawLine drawWin gece (x1,y1) (x2,y2)
  mapM_ (affiche can) ( points 500 300)
  widgetQueueDraw can
  --drawLine drawWin gece (10,10) (100,100)
  return True

Answer 2

发生了一些事情：

我可能错了，但我认为 widgetQueueDraw 只会请求刷新 canvas。既然你已经在画了，我猜它会被忽略。
即使您尝试将 canvas 标记为 需要刷新到屏幕缓冲区 ，也只是运行ning在同一线程中，您有一个待处理的计算，直到它可以自由地进行运行其他操作（例如刷新 canvas）。所以，一切都是先画后呈现。

我认为没有一种干净的方法可以强制显示 canvas。如果是这样，你需要的是使用多线程。下面是一个工作示例（请注意，所有 Gtk 操作都需要在 UI 线程中进行运行，这是由 postGUISync 确保的）。您需要使用 -threaded 标志对其进行编译，该标志嵌入并使用线程运行时间系统（又名 RTS）。

module Main where

import Control.Concurrent
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Windows.Window
import Graphics.UI.Gtk.Misc.DrawingArea
import System.Random
import           Control.Monad            (when,void)


k :: Int
k=100 -- 100 : after launching, u must wait less than 10s

mandelbrot :: Double -> Double -> Bool
mandelbrot a b =
  let
    mandelrec :: Double -> Double -> Int -> Bool
    mandelrec x y i
      | (x * x + y * y > 4) = False
      | (i==k) && (x * x + y * y <= 4) = True
      | otherwise = mandelrec x' y' (i+1)
            where x' = x * x - y * y + a
                  y' = 2 * x * y + b
  in mandelrec 0 0 0

colonnes :: Double -> [(Int, Double)]
colonnes w = [ (t,(fromIntegral t)/w*4-2) | t<-[0..((floor w)-1)] ]

lignes :: Double -> [(Int, Double)]
lignes h = [ (t,(fromIntegral t)/h*4-2) | t<-[0..((floor h)-1)] ]

points :: Double -> Double -> [((Int, Double), (Int, Double))]
points w h = [ (colonne,ligne)| colonne <- colonnes w,ligne <- lignes h]


main :: IO ()
main = do
  putStrLn "Hello World"
  initGUI
  win <- windowNew
  onDestroy win mainQuit
  dAre <- drawingAreaNew
  dAre `onSizeRequest` return (Requisition 500 300)
  dAre `onExpose` drawCanvas dAre
  win `containerAdd` dAre

  widgetShowAll win
  mainGUI

affiche2 :: DrawingArea -> Int -> Int -> IO Bool
affiche2 can a b = do
  postGUISync $ do drawWin <- widgetGetDrawWindow can
                   gece <- gcNew drawWin
                   drawLine drawWin gece (a,b) (a,b)
  return True

affiche :: DrawingArea -> ((Int,Double), (Int,Double)) -> IO()
affiche can ((a0,a), (b0,b)) =
  when (mandelbrot a b) $ void (affiche2 can a0 b0)

drawCanvas :: DrawingArea -> event -> IO Bool
drawCanvas can _evt = do
  drawWin <- widgetGetDrawWindow can
  drawWindowClear drawWin
  gece <- gcNew drawWin
  forkIO $ mapM_ (affiche can) (points 500 300)
  return True

haskell & gtk : "widgetGetDrawWindow: no DrawWindow available"

haskell & gtk : "widgetGetDrawWindow: no DrawWindow available"

gtk

plot

haskell