gtk2hs not rendering drawingArea

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

gtk2hs not rendering drawingArea

Norbert Wojtowicz
Hello,

I'm having problems getting a drawingArea to render, I've narrowed the
program down to the following skeleton. Any suggestions on what I'm
doing wrong? The label gets updated correctly, but the drawingArea
just remains gray as if it was never rendered. I'm including an entire
compilable skeleton in case someone wants to help me debug it. (I have
a feeling I'm just missing something very obvious...)

Thanks in advance,
Norbert

skeletonTest.hs:

module Main where
import Graphics.UI.Gtk -- hiding (fill)
import Graphics.UI.Gtk.Glade
import Graphics.Rendering.Cairo.SVG
import Graphics.Rendering.Cairo
import Control.Monad

main = do
  initGUI
  let gFile = "brainSpin.glade"
  windowXmlM <- xmlNew gFile
  let windowXml = case windowXmlM of
                    (Just windowXml) -> windowXml
                    Nothing -> error "Can't find the glade file
\"brainSpin.glade\" in the current directory"
  window <- xmlGetWidget windowXml castToWindow "brainSpinMain"
  onDestroy window mainQuit
  label <- xmlGetWidget windowXml castToLabel "label1"
  drawArea <- xmlGetWidget windowXml castToDrawingArea "drawArea"
  widgetShowAll window
  labelSetText label "foo"

  -- THIS is the offending code. Originally I was working with SVGs,
but I simplified
  -- it to this, just to track down the problem. It seems any Render () does not
  -- get updated in the drawArea
  let r = do setSourceRGB 0 0 0
             paint
  drawin <- widgetGetDrawWindow drawArea
  renderWithDrawable drawin r

  mainGUI


brainSpin.glade:

<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE glade-interface SYSTEM "glade-2.0.dtd">
<!--Generated with glade3 3.4.5 on Thu Dec  4 12:50:25 2008 -->
<glade-interface>
  <widget class="GtkWindow" id="brainSpinMain">
    <child>
      <widget class="GtkVBox" id="vbox1">
        <property name="visible">True</property>
        <child>
          <widget class="GtkLabel" id="label1">
            <property name="visible">True</property>
            <property name="label" translatable="yes">label</property>
          </widget>
        </child>
        <child>
          <widget class="GtkDrawingArea" id="drawArea">
            <property name="visible">True</property>
          </widget>
          <packing>
            <property name="position">1</property>
          </packing>
        </child>
      </widget>
    </child>
  </widget>
</glade-interface>
Reply | Threaded
Open this post in threaded view
|

gtk2hs not rendering drawingArea

Johann Giwer
On Thu, Dec 04, 2008 at 01:07:06PM +0100, Norbert Wojtowicz wrote:

> Hello,
>
> I'm having problems getting a drawingArea to render, I've narrowed the
> program down to the following skeleton. Any suggestions on what I'm
> doing wrong? The label gets updated correctly, but the drawingArea
> just remains gray as if it was never rendered. I'm including an entire
> compilable skeleton in case someone wants to help me debug it. (I have
> a feeling I'm just missing something very obvious...)
>
> Thanks in advance,
> Norbert
>
> skeletonTest.hs:
>
> module Main where
> import Graphics.UI.Gtk -- hiding (fill)
> import Graphics.UI.Gtk.Glade
> import Graphics.Rendering.Cairo.SVG
> import Graphics.Rendering.Cairo
> import Control.Monad
>
> main = do
>   initGUI
>   let gFile = "brainSpin.glade"
>   windowXmlM <- xmlNew gFile
>   let windowXml = case windowXmlM of
>                     (Just windowXml) -> windowXml
>                     Nothing -> error "Can't find the glade file
> \"brainSpin.glade\" in the current directory"
>   window <- xmlGetWidget windowXml castToWindow "brainSpinMain"
>   onDestroy window mainQuit
>   label <- xmlGetWidget windowXml castToLabel "label1"
>   drawArea <- xmlGetWidget windowXml castToDrawingArea "drawArea"
>   widgetShowAll window
>   labelSetText label "foo"
>
>   -- THIS is the offending code. Originally I was working with SVGs,
> but I simplified
>   -- it to this, just to track down the problem. It seems any Render () does not
>   -- get updated in the drawArea
>   let r = do setSourceRGB 0 0 0
>              paint
>   drawin <- widgetGetDrawWindow drawArea
>   renderWithDrawable drawin r
>
>   mainGUI


Drawing must be done when the widget is exposed. The changes in the
code below are mainly taken from demo/svg/SvgViewer.hs.
 
main = do

  svg <- svgNewFromFile "/path/to/svg/file"
  let (width, height) = svgGetSize svg

  initGUI
  let gFile = "brainSpin.glade"
  windowXmlM <- xmlNew gFile
  let windowXml = case windowXmlM of
                    (Just windowXml) -> windowXml
                    Nothing -> error "Can't find the glade file \"brainSpin.glade\" in the current directory"
  window <- xmlGetWidget windowXml castToWindow "brainSpinMain"
  onDestroy window mainQuit
  label <- xmlGetWidget windowXml castToLabel "label1"
  drawArea <- xmlGetWidget windowXml castToDrawingArea "drawArea"
  -- Here we go
  onSizeRequest drawArea $ return (Requisition width height)
  onExpose drawArea $ updateCanvas drawArea svg

  widgetShowAll window
  labelSetText label "foo"

  mainGUI


updateCanvas :: DrawingArea -> SVG -> Event -> IO Bool
updateCanvas canvas svg (Expose { eventArea=rect }) = do
  drawin <- widgetGetDrawWindow canvas
  let (width, height) = svgGetSize svg
  (width', height') <- widgetGetSize canvas
  renderWithDrawable drawin $ do
    scale (realToFrac width'  / realToFrac width)
          (realToFrac height' / realToFrac height)
    svgRender svg
  return True

Hope, that's what you expected.

-Johann
Reply | Threaded
Open this post in threaded view
|

gtk2hs not rendering drawingArea

Norbert Wojtowicz
Thanks Johann!

That explains what I was doing wrong. For my purposes, I switched over
to the onExposeRect, but the same idea still holds. Thanks for
pointing me in the right direction.