Haskell GTK, двойная буферизация с примитивами - PullRequest
1 голос
/ 13 марта 2011

С таким примером.Как я могу сделать двойную буферизацию с помощью gtk и haskell.Я хочу сделать примитивы вне буфера и перевернуть.Этот код отображает только пиксель / прямоугольник.Я хочу добавить движение, используя двойной буферный подход.

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 ]

2 голосов
/ 15 марта 2011

Это то, что я использую, чтобы рисовать Каиром в области рисования и избегать мерцания.Попробуйте добавить этот код в функцию 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
0 голосов
/ 15 марта 2011

Возможно, стоит взглянуть на 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.Не знаю, является ли это лучшим способом сделать это, но на практике это работает достаточно хорошо.Надеюсь, это поможет.

...