[Real World Haskell翻译]第23章 GUI编程使用gtk2hs

第23章 GUI编程使用gtk2hs

在本书中，我们一直在开发简单的基于文本的工具。虽然这些往往是理想的接口，但有时图形用户界面（GUI）是必需的。有几个Haskell的GUI工具包是可用的。在本章中，我们将着眼于其中一个，gtk2hs。

%多个替代选择存在。除了gtk2hs，wxHaskell也是一个著名的跨平台GUI工具包。

安装gtk2hs

在我们和gtk2hs工作之前，你需要安装它。在大多数Linux，BSD，或其他POSIX平台，你会发现已经编译好的gtk2hs包。一般你会需要安装GTK+开发环境，Glade，和gtk2hs。具体的做法在不同发行版下有所不同。
Windows和Mac开发人员应查阅gtk2hs的下载站点位于 http://www.haskell.org/gtk2hs/download/。从下载gtk2hs开始。然后，你会还需要Glade第3版。 Mac开发者可以在http://www.macports.org/找到这个，Windows开发人员应该查阅http://sourceforge.net/projects/gladewin32。

GTK+体系结构概述

在研究代码之前，让我们暂停一会并考虑我们将要使用的系统的体系结构。首先，我们有GTK+。GTK+是一个跨平台的采用C语言编写的GUI构建工具包。它可以运行在Windows，Mac，Linux，BSD等系统。这也是GNOME桌面环境下的工具包。
接下来，我们有Glade。Glade是用户界面设计器，它可以让你以图形化方式布局出您的应用程序的窗口和对话框。Glade在XML文件中保存接口，您的应用程序在运行时会加载该文件。
体系结构中的最后一块是gtk2hs。这是GTK+,Glade和几个相关库的Haskell绑定。它是GTK+的多种语言绑定中的一个。

用Glade进行用户界面设计

在本章中，我们将为我们在第22章开发的播客下载器开发一个GUI。我们的首要任务是在Glade中设计用户界面。一旦我们完成这一点，我们将编写Haskell代码将其与应用程序集成。
因为这是一本Haskell的书，而不是一个GUI设计的书，我们将快速介绍这些早期部分中的一些。欲了解用Glade进行界面设计的更多信息，您可以参照这些资源：
Glade主页
包含Glade文档；查看http://glade.gnome.org/。
GTK+主页
包含不同widgets的信息。请参阅文档中GTK的部分；查看http://www.gtk.org/。
gtk2hs主页
也有一个有用的文档，其中包含gtk2hs的API参考；查看http://www.haskell.org/gtk2hs/documentation/。

Glade概念

Glade是一个用户界面设计工具。它让我们使用一个图形界面来设计我们的图形界面。我们可以使用一堆GTK+函数调用来建立窗口组件，但使用Glade通常更容易做这些。
我们使用GTK+工作的根本的“东西”是widget。一个widget代表图形用户界面的任何一部分，并可能含有其它widget。一些widget的例子包括window, dialog box, button, and text within the button。
Glade，是一个widget布局工具。我们建立了widget的整棵树，顶级的窗口在树的顶部。你可以认为Glade和widget在某些地方和HTML相同：你可以安排widget在一个类似表的布局，设置填充规则并分层构建整个描述。
Glade保存widget描述到一个XML文件中。我们的程序在运行时加载这个XML文件。我们通过要求Glade运行时库加载一个特定名称的widget来加载widget。
图23-1给出了用Glade来设计我们的应用程序的主屏幕的例子的截图。
在这本书的可下载的资料中，你可以找到完整的Glade XML文件作为podresources.glade。您可以在Glade中加载此文件并编辑它，如果你愿意。

%图23-1%

%图23-1。Glade截图，显示图形用户界面的组件

事件驱动编程

像许多GUI工具包，GTK+是一个事件驱动工具包。这意味着，不是显示一个对话框，并等待用户点击一个按钮，而是如果某个确定的按钮被点击，我们告诉gtk2hs调用什么函数，而不是等待对话框中的点击。
这是与控制台程序使用的传统模型不同的。当你思考它，它确实应该是这样的。一个GUI程序可能有多个窗口打开，编写代码等待打开的窗口的特定组合的输入是一个复杂的命题。
事件驱动编程是Haskell的很好的补充。正如我们已经一遍一遍在这本书中讨论过，函数式语言以传递函数为长。因此，我们将传递函数给gtk2hs，当某些事件发生时它被调用。这些被称为回调函数。
GTK+程序的核心是main循环。这是等待来自用户的action或者来自程序的命令并执行的程序的部分。
GTK+主循环完全由GTK+处理。对我们来说，它看起来像一个我们执行的I/O action，它不返回直到GUI停止。
由于主循环是负责处理从鼠标点击到重绘窗口的所有事情，它必须始终可用。我们不能只运行一个长时间运行的任务，如下载播客清单在主循环内。这将使GUI响应缓慢，点击“取消”按钮将不能及时地处理。
因此，我们将使用多线程来处理这些长时间运行的任务。更多多线程的信息，可以查阅第24章。现在，只需要知道我们将使用forkIO来创建新的线程处理长时间运行的任务，如下载播客feed和清单。对于非常快的任务，如添加一个新的播客到数据库，我们不会用到一个单独的线程因为它执行很快用户从不会注意到。

初始化GUI

我们的第一个步骤是为我们的程序初始化GUI。由于我们稍后将在本章的第528页“Using Cabal”中解释，我们将有一个叫做PodLocalMain.hs的小文件，它加载PodMain并传递给它podresources.glade的路径，这是Glade保存的XML文件，它给出了关于widget的信息：

-- file: ch23/PodLocalMain.hs
module Main where

import qualified PodMainGUI

main = PodMainGUI.main "podresources.glade"

现在，让我们考虑PodMainGUI.hs。这个文件是唯一的Haskell源文件，我们不得不修改第22章中的例子使其作为GUI工作。让我们从研究我们的新的PodMainGUI.hs的开头开始，对了清楚，我们将PodMain.hs重新命名：

-- file: ch23/PodMainGUI.hs
module PodMainGUI where

import PodDownload
import PodDB
import PodTypes
import System.Environment
import Database.HDBC
import Network.Socket(withSocketsDo)

-- GUI libraries

import Graphics.UI.Gtk hiding (disconnect)
import Graphics.UI.Gtk.Glade

-- Threading

import Control.Concurrent

PodMainGUI.hs的第一部分类似于我们的非GUI版本。但我们导入了三个额外的组件。首先，我们有Graphics.UI.Gtk，它提供了我们将使用的大多数的GTK+的函数。这个模块和Database.HDBC都提供一个名为disconnect的函数。由于我们将使用HDBC版本，而不使用GTK+版本，我们不从Graphics.UI.Gtk导入该函数。Graphics.UI.Gtk.Glade包含加载和处理Glade文件所需的函数。
我们还导入了Control.Concurrent，其中有多线程编程所需的基础。一旦我们进入程序的内部，我们将使用来自上述的一些函数。接下来，让我们来定义一个存储我们的GUI的信息的类型：

-- file: ch23/PodMainGUI.hs
-- | Our main GUI type
data GUI = GUI {
      mainWin :: Window,
      mwAddBt :: Button,
      mwUpdateBt :: Button,
      mwDownloadBt :: Button,
      mwFetchBt :: Button,
      mwExitBt :: Button,
      statusWin :: Dialog,
      swOKBt :: Button,
      swCancelBt :: Button,
      swLabel :: Label,
      addWin :: Dialog,
      awOKBt :: Button,
      awCancelBt :: Button,
      awEntry :: Entry}

我们的新type存储我们在整个程序中关心的所有的widget。大的程序可能不希望有这样的统一的类型。对于这个小例子，它是有意义的，因为它可以很容易地传递给不同的函数，我们将知道，我们总是有我们需要的信息在可用状态。
在此记录中，我们有Window（顶层窗口），Dialog（对话窗口），Button（可点击的按钮），Label（一段文字）和Entry（用户输入文字的地方）字段。现在，让我们来看看我们的main函数：

-- file: ch23/PodMainGUI.hs
main :: FilePath -> IO ()
main gladepath = withSocketsDo $ handleSqlError $
    do initGUI -- Initialize GTK+ engine

       -- Every so often, we try to run other threads.
       timeoutAddFull (yield >> return True)
                      priorityDefaultIdle 100

       -- Load the GUI from the Glade file
       gui <- loadGlade gladepath

       -- Connect to the database
       dbh <- connect "pod.db"

       -- Set up our events 
       connectGui gui dbh

       -- Run the GTK+ main loop; exits after GUI is done
       mainGUI

       -- Disconnect from the database at the end
       disconnect dbh

请记住这个main函数的类型和平常有点不同，因为它被PodLocalMain.hs中的main所调用。我们通过调用initGUI开始，它初始化GTK+系统。接下来，我们调用timeoutAddFull。这个调用只为多线程GTK+程序需要。它每隔一段时间告诉GTK+ main循环去暂停给其他线程运行的机会。
在那之后，我们调用loadGlade函数（见下面的代码）来从我们的Glade XML文件加载widget。下一步，我们连接我们的数据库，并调用我们的connectGui函数来设置我们的回调函数。然后，我们点燃GTK+ main循环。我们预计它可能是数分钟，数小时，甚至数天在mainGUI返回前。当它返回时，这意味着用户已经关闭了主窗口，或点击了“退出”按钮。在那之后，我们从数据库断开连接，并关闭该程序。现在，让我们看看我们的loadGlade函数：

-- file: ch23/PodMainGUI.hs
loadGlade gladepath =
    do -- Load XML from glade path.
       -- Note: crashes with a runtime error on console if fails!
       Just xml <- xmlNew gladepath

       -- Load main window
       mw <- xmlGetWidget xml castToWindow "mainWindow"

       -- Load all buttons

       [mwAdd, mwUpdate, mwDownload, mwFetch, mwExit, swOK, swCancel,
        auOK, auCancel] <-
           mapM (xmlGetWidget xml castToButton)
           ["addButton", "updateButton", "downloadButton",
            "fetchButton", "exitButton", "okButton", "cancelButton",
            "auOK", "auCancel"]

       sw <- xmlGetWidget xml castToDialog "statusDialog"
       swl <- xmlGetWidget xml castToLabel "statusLabel"

       au <- xmlGetWidget xml castToDialog "addDialog"
       aue <- xmlGetWidget xml castToEntry "auEntry"

       return $ GUI mw mwAdd mwUpdate mwDownload mwFetch mwExit
              sw swOK swCancel swl au auOK auCancel aue

此函数通过调用xmlNew开始，它载入Glade XML文件。它在错误时返回Nothing。成功时我们使用模式匹配来提取结果值。如果失败的话，会有一个控制台（非图形界面）异常显示出来；在本章结尾的练习会阐述这个。
现在，我们有已加载的Glade的XML文件，你会看到一系列对xmlGetWidget的调用。此Glade函数是用来加载定义了widget的XML并为那个widget返回一个GTK+ widget类型。我们要传递给那个函数一个表明我们期待的GTK+类型的值，我们将得到一个运行时错误，如果这些不匹配。
我们从创建一个主窗口widget开始。它在XML widget中名为“mainWindow”，我们加载它并把它存储在mw变量中。然后，我们使用模式匹配和mapM来加载所有的button。然后，我们有两个dialog，一个label和一个entry被载入。最后，我们使用所有这些来建立GUI类型并返回它。接下来，我们需要建立我们的回调函数作为事件处理程序：

-- file: ch23/PodMainGUI.hs
connectGui gui dbh =
  do -- When the close button is clicked, terminate the GUI loop
     -- by calling GTK mainQuit function
     onDestroy (mainWin gui) mainQuit

     -- Main window buttons
     onClicked (mwAddBt gui) (guiAdd gui dbh)
     onClicked (mwUpdateBt gui) (guiUpdate gui dbh)
     onClicked (mwDownloadBt gui) (guiDownload gui dbh)
     onClicked (mwFetchBt gui) (guiFetch gui dbh)
     onClicked (mwExitBt gui) mainQuit

     -- We leave the status window buttons for later

我们通过调用OnDestroy启动connectGui函数。这意味着，当有人点击操作系统的关闭按钮（Windows或Linux上通常是一个在标题栏的X或Mac OS X上的一个红色圆圈），我们在主窗口上调用mainQuit函数。mainQuit关闭了所有的GUI窗口并终止了GTK+的main循环。
接下来，我们调用onClicked为点击五个不同的按钮来注册事件处理程序。对于按钮，如果用户通过键盘选择按钮，这些handler也会被调用。点击这些按钮将调用我们的函数，如guiAdd，传递GUI记录以及数据库handle。
在这一点上，我们已经完全为图形用户界面的播客采集软体的定义了主窗口。它看起来像图23-2中的截图。

%图23-2%

%图23-2。播客采集应用程序的主窗口截图

添加播客窗口

现在，我们已经介绍了主窗口，让我们来谈谈我们的应用呈现的其他的窗口，从添加播客的窗口开始。当用户点击按钮来添加一个新的播客，我们需要弹出一个对话框并提示输入播客的URL。我们在Glade中定义了这个对话框，所以我们需要做的就是将它加载进来：

-- file: ch23/PodMainGUI.hs
guiAdd gui dbh = 
    do -- Initialize the add URL window
      entrySetText (awEntry gui) ""
      onClicked (awCancelBt gui) (widgetHide (addWin gui))
      onClicked (awOKBt gui) procOK

      -- Show the add URL window
      windowPresent (addWin gui)
    where procOK =
              do url <- entryGetText (awEntry gui)
                 widgetHide (addWin gui) -- Remove the dialog
                 add dbh url -- Add to the DB

我们通过调用设置输入框内容为空字符串（用户输入URL的地方）的entrySetText开始。因为相同的widget在程序的整个生命周期得到重用，我们不希望用户输入的URL留在那里。接下来，我们为对话框中的两个按钮设置action。如果用户点击“取消”按钮，我们只需通过调用widgetHideon删除屏幕上的对话框。如果用户点击“确定”按钮，我们调用procOK。
procOK通过检索由入口的widget所提供的URL开始。接着，它使用widgetHide来脱离对话框。最后，它调用add把URL添加到数据库。此add和我们在非图形化界面版本的程序中的函数是完全相同。
我们在guiAdd中做的最后一件事实际上是显示弹出式窗口。这是通过调用和widgetHide相对的windowPresent完成的。

%图23-3%

%图23-3。 增加播客窗口截图
%需要注意的是guiAdd函数几乎立即返回。它只是设置并启动widget，显示这些widget；它在任何时候阻塞并等待输入。图23-3展示了对话框的样子。

长时间运行的任务

我们认为在主窗口中的按钮是可用的，他们三个对应需要一段时间完成的任务：更新，下载，和获取。当这些操作进行的时候，我们希望在我们的GUI中做两件事情：为用户提供操作的状态和在它运行时取消操作的能力。
由于这三件事情是非常相似的操作，提供通用的方式处理这些交互是在情理之中。我们已经在Glade文件中定义了一个单独的状态窗口widget，它将被这些交互使用。在我们的Haskell源代码中，我们将定义一个用于这三个操作的通用的statusWindow函数。
statusWindow需要四个参数：GUI信息，数据库信息，一个窗口标题的String，一个执行任务的函数。此函数将被传递给一个可以报告它的进度的函数。代码如下：

-- file: ch23/PodMainGUI.hs
statusWindow :: IConnection conn =>
                GUI 
             -> conn 
             -> String 
             -> ((String -> IO ()) -> IO ())
             -> IO ()
statusWindow gui dbh title func =
    do -- Clear the status text
       labelSetText (swLabel gui) ""

       -- Disable the OK button, enable Cancel button
       widgetSetSensitivity (swOKBt gui) False
       widgetSetSensitivity (swCancelBt gui) True

       -- Set the title
       windowSetTitle (statusWin gui) title

       -- Start the operation
       childThread <- forkIO childTasks

       -- Define what happens when clicking on Cancel
       onClicked (swCancelBt gui) (cancelChild childThread)

       -- Show the window
       windowPresent (statusWin gui)
    where childTasks =
              do updateLabel "Starting thread..."
                 func updateLabel
                 -- After the child task finishes, enable OK
                 -- and disable Cancel
                 enableOK

          enableOK = 
              do widgetSetSensitivity (swCancelBt gui) False
                 widgetSetSensitivity (swOKBt gui) True
                 onClicked (swOKBt gui) (widgetHide (statusWin gui))
                 return ()

          updateLabel text =
              labelSetText (swLabel gui) text
          cancelChild childThread =
              do killThread childThread
                 yield
                 updateLabel "Action has been cancelled."
                 enableOK

此函数从清除来自最后运行的标签文本开始。接下来，我们禁用（设成灰色）“确定”按钮并启用“取消”按钮。当操作在进行中时，单击“确定”并没有太大的意义。当它完成时，单击“取消”也不会有多大的意义。
接下来，我们设置窗口的标题。标题是系统在窗口的标题栏中显示的一部分。最后，我们开始新的线程（显示为childTasks）并保存其线程ID。然后，我们定义了如果用户点击取消我们将调用cancelChild，并传递线程ID给它。最后，我们调用windowPresent显示状态窗口。
在childTasks中，我们显示一个消息，“我们正在启动线程”。然后我们调用实际工作的函数，传递给用于显示状态消息的updateLabelas函数。需要注意的是命令行版本的程序可以在这里传递putStrLn。
最后，worker函数退出后，我们调用enableOK。该函数禁用“取消”按钮，启用“确定”按钮，并定义点击“确定”按钮将导致状态窗口消失。
updateLabel在label widget上简单地调用labelSetText更新显示的文本。最后，cancelChild杀掉正在处理任务的线程，更新label，并启用“确定”按钮。
我们现在有基础来定义我们的三个GUI函数。他们看起来像这样：

-- file: ch23/PodMainGUI.hs
guiUpdate :: IConnection conn => GUI -> conn -> IO ()
guiUpdate gui dbh = 
    statusWindow gui dbh "Pod: Update" (update dbh)

guiDownload gui dbh =
    statusWindow gui dbh "Pod: Download" (download dbh)

guiFetch gui dbh =
    statusWindow gui dbh "Pod: Fetch" 
                     (logf -> update dbh logf >> download dbh logf)

为简单起见，我们只给出了第一个的类型，但这三个具有相同的类型，Haskell可以通过类型推断推断出来。请注意我们的guiFetch的实现。我们不能调用statusWindow两次，但是可以结合在action中组合函数。
代码的最后一块由三个函数组成。add来自命令行的章节且未被修改。update和download仅修改去取得一个logging函数，而不是调用putStrLn用于状态更新。

-- file: ch23/PodMainGUI.hs
add dbh url = 
    do addPodcast dbh pc
       commit dbh
    where pc = Podcast {castId = 0, castURL = url}

update :: IConnection conn => conn -> (String -> IO ()) -> IO ()
update dbh logf = 
    do pclist <- getPodcasts dbh
       mapM_ procPodcast pclist
       logf "Update complete."
    where procPodcast pc =
              do logf $ "Updating from " ++ (castURL pc)
                 updatePodcastFromFeed dbh pc

download dbh logf =
    do pclist <- getPodcasts dbh
       mapM_ procPodcast pclist
       logf "Download complete."
    where procPodcast pc =
              do logf $ "Considering " ++ (castURL pc)
                 episodelist <- getPodcastEpisodes dbh pc
                 let dleps = filter (ep -> epDone ep == False)
                             episodelist
                 mapM_ procEpisode dleps
          procEpisode ep =
              do logf $ "Downloading " ++ (epURL ep)
                 getEpisode dbh ep

图23-4显示了运行更新后最后的结果看起来是什么样。

%图23-4%

%图23-4。显示“更新完成”的对话框的截图

使用Cabal

我们在“第515页展示了一个建立这个项目的命令行版本的Cabal文件。我们需要做出一些调整使它工作在我们的GUI版本下。首先，明显需要添加gtk2hs包到构建依赖关系的列表。Glade XML文件也需要用这个方法处理。
此前，我们写了一个PodLocalMain.hs文件，简单地假设该文件被命名为podresources.glade并存储在当前工作目录。对于一个真正的，系统级的安装，我们不能做这样的假设。此外，不同的系统可能把文件放置在不同的位置。
Cabal提供了解决这个问题的一种方法。它会自动生成一个根据环境的不同导出函数的模块。我们必须添加一个Data-files行到我们的Cabal描述文件。所有数据文件的文件名将会是系统级安装的一部分。接着，Cabal将导出在运行时我们可以询问位置的Paths_pod模块（“pod”部分来自Cabal文件中的Name行）。这里是我们的新的Cabal描述文件：

-- ch24/pod.cabal
Name: pod
Version: 1.0.0
Build-type: Simple
Build-Depends: HTTP, HaXml, network, HDBC, HDBC-sqlite3, base, 
gtk, glade
Data-files: podresources.glade

Executable: pod
Main-Is: PodCabalMain.hs
GHC-Options: -O2

接着这里是PodCabalMain.hs：

-- file: ch23/PodCabalMain.hs
module Main where

import qualified PodMainGUI
import Paths_pod(getDataFileName)

main = 
    do gladefn <- getDataFileName "podresources.glade"
       PodMainGUI.main gladefn

%练习
%1。如果调用xmlNew返回Nothing，就显示一个有帮助的GUI错误消息。
%2。修改播客采集软体使其可以运行在GUI或命令行界面。提示：将共同的命令从PodMainGUI.hs移出，然后有两个不同的Main模块，一个用于GUI，和一个用于
命令行。
%3。为什么guiFetch连接worker函数，而不是调用statusWindow两次？