haskell & gtk："widgetGetDrawWindow:没有可用的DrawWindow“

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

有几件事发生了：

• 我可能错了，但我认为widgetQueueDraw只会要求刷新画布。既然你已经在画了，我猜它会被忽略。
• 即使您试图将画布标记为需要刷新到屏幕缓冲区，它也都在同一个线程中运行，并且您有一个挂起的计算，直到它可以自由运行其他操作(比如刷新画布)。所以，所有的东西都会先画出来，然后再呈现。

我不认为有一个干净的方法来强迫画布呈现。如果是这样，您需要的是使用多个线程。下面是一个工作示例(请注意，所有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

Answer 2

我通过将mapM_语句放入updateCanvas函数来解决这个问题，但是所有的绘图都是在计算了所有的点之后显示的，这不是我想要得到的:由于曼德尔布罗集的部分越小，计算时间就越长，我希望在创建绘图时看到它，而不是等待很长时间。

你知道如何达到这个目标吗？

以下是工作代码：

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