Haskell GTK,带有基元的双缓冲

时间:2011-03-13 05:20:12

标签: haskell gtk gtk2hs

这样的例子。如何使用gtk和haskell进行2D缓冲。我想将基元渲染到屏幕外缓冲区并翻转。此代码仅呈现像素/矩形。我想使用双缓冲方法添加运动。

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk hiding (Color, Point, Object)

defaultFgColor :: Color
defaultFgColor = Color 65535 65535 65535

defaultBgColor :: Color
defaultBgColor = Color 0 0 0

renderScene d ev = do
    dw     <- widgetGetDrawWindow d
    (w, h) <- widgetGetSize d
    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 20 20 20 20
    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
    onExpose drawing (renderScene drawing)

    onDestroy window mainQuit
    windowSetDefaultSize window 800 600
    windowSetPosition window WinPosCenter
    widgetShowAll window
    mainGUI

2 个答案:

答案 0 :(得分:2)

这是我在绘图区域使用cairo绘制并避免使用的内容 闪烁。尝试将此代码添加到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

答案 1 :(得分:0)

查看ThreadScope可能是个主意。滚动在那里实现的东西非常接近双缓冲。这是我认为他们所做的简化版本:

prev_surface <- readIORef prevView
win <- widgetGetDrawWindow timelineDrawingArea
renderWithDrawable win $ do

  -- Create new surface based on the old one
  new_surface <- liftIO $ createSimilarSurface [...]
  renderWith new_surface $ do
    setSourceSurface prev_surface off 0
    Cairo.rectangle [...]
    Cairo.fill
    [... render newly exposed stuff ...]
  surfaceFinish new_surface

  -- Save back new view
  liftIO $ writeIORef prevView new_surface

  -- Paint new view
  setSourceSurface new_surface 0 0
  setOperator OperatorSource
  paint

实际代码可在Timeline/Render.hs中找到。不知道这是否是最好的方法,但它似乎在实践中运作良好。我希望这会有所帮助。