Haskell Gtk2Hs Gtk3中如何从DrawingArea获取Drawable或DrawWindow

问题 #

我需要在Haskell+Gtk2Hs+Gtk3环境下开发一款地图投影转换应用，实现窗口局部区域绘图，第一步要让用户在图像上标记经纬线。我用Glade创建了带名为“area”的DrawingArea的窗口，编写了如下代码：

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Abstract.Widget
import Graphics.UI.Gtk.Misc.DrawingArea

main = do
   initGUI
   builder <- builderNew
   builderAddFromFile builder "Atlas.glade"
   window <- builderGetObject builder castToWindow "window"
   area   <- builderGetObject builder castToDrawingArea "area"
   on area   exposeEvent  (drawGrid area)
   --on window destroyEvent $ \e -> do 
   widgetShow window
   mainGUI

lamaziOfSph (psi, theta) = (2 * cos (psi / 2), -theta)
sphOfLamazi (r, theta) = (2 * acos (r / 2), -theta)
cartOfPol s (r, theta) = (r * s * sin theta + s, r * s * cos theta + s)

drawGrid area = do
   let t = cartOfPol 100 . lamaziOfSph
   d <- eventArea
   drawWindow <- drawingAreaGetDrawWindow area
   --sequence $ concat $ crossWith (\x y -> drawLine d gc (t (x, y)) (t (x + 10, y))) [-180,-170..180] [-90,-80..90]
   --sequence $ concat $ crossWith (\x y -> drawLine d gc (t (x, y)) (t (x, y + 10))) [-180,-170..180] [-90,-80..90]
   return 

运行时出现错误：

ghci> :re
[5 of 5] Compiling Map              ( Atlas.hs, interpreted )

Atlas.hs:268:14: error: [GHC-88464]
    Variable not in scope:
      drawingAreaGetDrawWindow
        :: transformers-0.6.1.0:Control.Monad.Trans.Reader.ReaderT
             (GHC.Ptr.Ptr EExpose) IO a0
    |
268 |    window <- drawingAreaGetDrawWindow
    |              ^^^^^^^^^^^^^^^^^^^^^^^^
Failed, four modules loaded.

补充说明：gtk3-0.15.9版本的Graphics.UI.Gtk.Abstract.Widget.chs模块中，仅在GTK主版本小于3时才导出widgetGetDrawWindow。

请问如何解决该问题，成功从DrawingArea获取Drawable或DrawWindow？

解决方案 #

在GTK3的Gtk2Hs绑定中，drawingAreaGetDrawWindow已被移除，且widgetGetDrawWindow仅兼容GTK2。要实现绘图，需改用GTK3推荐的Cairo上下文绘图方案，具体修改如下：

1. 调整导入模块 #

添加Cairo相关模块，用于处理绘图上下文：

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Cairo  -- 新增：导入Cairo绘图相关函数
import Graphics.UI.Gtk.Misc.DrawingArea

2. 替换信号回调 #

GTK3中expose-event信号已被弃用，改用draw信号，该信号直接传入Cairo绘图上下文，无需手动获取DrawWindow：

-- 原代码：on area exposeEvent (drawGrid area)
on area draw $ drawGrid  -- 修改为绑定draw信号

3. 重写绘图函数 #

修改drawGrid，接收Cairo.Context作为参数，直接使用Cairo函数绘图，同时修正角度转弧度的逻辑（三角函数需传入弧度值）：

drawGrid :: Cairo.Context -> IO Bool
drawGrid cr = do
   let t = cartOfPol 100 . lamaziOfSph
       degToRad d = d * pi / 180  -- 角度转弧度
       t' (x, y) = t (degToRad x, degToRad y)
   
   -- 设置线条样式
   setSourceRGB cr 0 0 0  -- 黑色线条
   setLineWidth cr 1.0
   
   -- 绘制纬线（固定纬度，遍历经度）
   mapM_ (\y -> do
       let (startX, startY) = t' (-180, y)
       moveTo cr startX startY
       mapM_ (\x -> let (px, py) = t' (x, y) in lineTo cr px py) [-170,-160..180]
       stroke cr
       ) [-90,-80..90]
   
   -- 绘制经线（固定经度，遍历纬度）
   mapM_ (\x -> do
       let (startX, startY) = t' (x, -90)
       moveTo cr startX startY
       mapM_ (\y -> let (px, py) = t' (x, y) in lineTo cr px py) [-80,-70..90]
       stroke cr
       ) [-180,-170..180]
   
   return True  -- 返回True表示事件已处理

4. 完善主函数逻辑 #

添加退出回调并改用widgetShowAll确保所有控件正常显示：

main = do
   initGUI
   builder <- builderNew
   builderAddFromFile builder "Atlas.glade"
   window <- builderGetObject builder castToWindow "window"
   area   <- builderGetObject builder castToDrawingArea "area"
   on area draw drawGrid
   on window destroy mainQuit  -- 添加程序退出回调
   widgetShowAll window  -- 显示所有控件（替代原widgetShow）
   mainGUI

完整修改后的代码 #

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Cairo
import Graphics.UI.Gtk.Misc.DrawingArea

main = do
   initGUI
   builder <- builderNew
   builderAddFromFile builder "Atlas.glade"
   window <- builderGetObject builder castToWindow "window"
   area   <- builderGetObject builder castToDrawingArea "area"
   on area draw drawGrid
   on window destroy mainQuit
   widgetShowAll window
   mainGUI

lamaziOfSph (psi, theta) = (2 * cos (psi / 2), -theta)
sphOfLamazi (r, theta) = (2 * acos (r / 2), -theta)
cartOfPol s (r, theta) = (r * s * sin theta + s, r * s * cos theta + s)

degToRad :: Double -> Double
degToRad d = d * pi / 180

drawGrid :: Cairo.Context -> IO Bool
drawGrid cr = do
   let t = cartOfPol 100 . lamaziOfSph
       t' (x, y) = t (degToRad x, degToRad y)
   
   setSourceRGB cr 0 0 0
   setLineWidth cr 1.0
   
   -- 绘制纬线
   mapM_ (\y -> do
       let (startX, startY) = t' (-180, y)
       moveTo cr startX startY
       mapM_ (\x -> let (px, py) = t' (x, y) in lineTo cr px py) [-170,-160..180]
       stroke cr
       ) [-90,-80..90]
   
   -- 绘制经线
   mapM_ (\x -> do
       let (startX, startY) = t' (x, -90)
       moveTo cr startX startY
       mapM_ (\y -> let (px, py) = t' (x, y) in lineTo cr px py) [-80,-70..90]
       stroke cr
       ) [-180,-170..180]
   
   return True

关键说明 #

• GTK3中不再使用DrawWindow作为绘图载体，直接通过Cairo上下文完成所有绘图操作是标准方案。
• 使用draw信号替代过时的expose-event，彻底规避API兼容性问题。
• widgetShowAll能确保Glade中创建的所有子控件（包括DrawingArea）都正确显示，原代码的widgetShow window可能无法加载子控件。

内容的提问来源于stack exchange，提问作者B Curtis