第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 whereimport qualified PodMainGUImain = PodMainGUI.main "podresources.glade"现在，让我们考虑PodMainGUI.hs。这个文件是唯一的Haskell源文件，我们不得不修改第22章中的例子使其作为GUI工作。让我们从研究我们的新的PodMainGUI.hs的开头开始，对了清楚，我们将PodMain.hs重新命名：-- file: ch23/PodMainGUI.hs
module PodMainGUI whereimport PodDownload
import PodDB
import PodTypes
import System.Environment
import Database.HDBC
import Network.Socket(withSocketsDo)-- GUI librariesimport Graphics.UI.Gtk hiding (disconnect)
import Graphics.UI.Gtk.Glade-- Threadingimport Control.ConcurrentPodMainGUI.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 filegui <- loadGlade gladepath-- Connect to the databasedbh <- connect "pod.db"-- Set up our events connectGui gui dbh-- Run the GTK+ main loop; exits after GUI is donemainGUI-- Disconnect from the database at the enddisconnect 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 windowmw <- 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 mwExitsw 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 functiononDestroy (mainWin gui) mainQuit-- Main window buttonsonClicked (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 windowentrySetText (awEntry gui) ""onClicked (awCancelBt gui) (widgetHide (addWin gui))onClicked (awOKBt gui) procOK-- Show the add URL windowwindowPresent (addWin gui)where procOK =do url <- entryGetText (awEntry gui)widgetHide (addWin gui) -- Remove the dialogadd 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 textlabelSetText (swLabel gui) ""-- Disable the OK button, enable Cancel buttonwidgetSetSensitivity (swOKBt gui) FalsewidgetSetSensitivity (swCancelBt gui) True-- Set the titlewindowSetTitle (statusWin gui) title-- Start the operationchildThread <- forkIO childTasks-- Define what happens when clicking on CancelonClicked (swCancelBt gui) (cancelChild childThread)-- Show the windowwindowPresent (statusWin gui)where childTasks =do updateLabel "Starting thread..."func updateLabel-- After the child task finishes, enable OK-- and disable CancelenableOKenableOK = do widgetSetSensitivity (swCancelBt gui) FalsewidgetSetSensitivity (swOKBt gui) TrueonClicked (swOKBt gui) (widgetHide (statusWin gui))return ()updateLabel text =labelSetText (swLabel gui) textcancelChild childThread =do killThread childThreadyieldupdateLabel "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 pccommit dbhwhere pc = Podcast {castId = 0, castURL = url}update :: IConnection conn => conn -> (String -> IO ()) -> IO ()
update dbh logf = do pclist <- getPodcasts dbhmapM_ procPodcast pclistlogf "Update complete."where procPodcast pc =do logf $ "Updating from " ++ (castURL pc)updatePodcastFromFeed dbh pcdownload dbh logf =do pclist <- getPodcasts dbhmapM_ procPodcast pclistlogf "Download complete."where procPodcast pc =do logf $ "Considering " ++ (castURL pc)episodelist <- getPodcastEpisodes dbh pclet dleps = filter (\ep -> epDone ep == False)episodelistmapM_ procEpisode dlepsprocEpisode 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.gladeExecutable: pod
Main-Is: PodCabalMain.hs
GHC-Options: -O2接着这里是PodCabalMain.hs：-- file: ch23/PodCabalMain.hs
module Main whereimport 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两次？
