[Haskell-beginners] 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