Это то, что я использую, чтобы рисовать Каиром в области рисования и избегать мерцания.Попробуйте добавить этот код в функцию renderScene:
-- Get the draw window (dw) and its size (w,h)
-- ...
regio <- regionRectangle $ Rectangle 0 0 w h
drawWindowBeginPaintRegion dw regio
-- Put paiting code here
-- ..
drawWindowEndPaint dw
Ваш окончательный код может выглядеть следующим образом:
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk hiding (Color, Point, Object)
import Data.IORef
defaultFgColor :: Color
defaultFgColor = Color 65535 65535 65535
defaultBgColor :: Color
defaultBgColor = Color 0 0 0
renderScene pref d _ev = renderScene' pref d
renderScene' :: IORef Int -> DrawingArea -> IO Bool
renderScene' pref d = do
dw <- widgetGetDrawWindow d
(w, h) <- widgetGetSize d
regio <- regionRectangle $ Rectangle 0 0 w h
pos <- readIORef pref
-- Go around, CCW, in a circle of size 20, centered at (100,100)
let x = 100 + round ( 20 * sin (fromIntegral pos * pi * 2 / 360) )
y = 100 + round ( 20 * cos (fromIntegral pos * pi * 2 / 360) )
pos' = (pos + 1) `mod` 360
writeIORef pref pos'
drawWindowBeginPaintRegion dw regio
gc <- gcNew dw
let fg = Color (round (65535 * 205))
(round (65535 * 0))
(round (65535 * 0))
gcSetValues gc $ newGCValues { foreground = fg }
drawPoint dw gc (120, 120)
drawPoint dw gc (22, 22)
drawRectangle dw gc True x y 20 20
-- Paint an extra rectangle
drawRectangle dw gc True 200 200 200 200
drawWindowEndPaint dw
return True
main :: IO ()
main = do
initGUI
window <- windowNew
drawing <- drawingAreaNew
windowSetTitle window "Cells"
containerAdd window drawing
let bg = Color (round (65535 * 205))
(round (65535 * 205))
(round (65535 * 255))
widgetModifyBg drawing StateNormal bg
pref <- newIORef 0
onExpose drawing (renderScene pref drawing)
timeoutAdd (renderScene' pref drawing) 10
onDestroy window mainQuit
windowSetDefaultSize window 800 600
windowSetPosition window WinPosCenter
widgetShowAll window
mainGUI