调用 C 库

MiniGtk

虽然Gtk 入门中概述的 lablgtk 结构可能显得过于复杂，但值得考虑作者选择两层的原因。要理解这一点，您确实需要亲自动手，看看 Gtk 包装器可能采用的其他方法。

为此，我尝试使用我称之为MiniGtk的东西进行了一些操作，它旨在作为 Gtk 的简单包装器。MiniGtk 唯一能做的事情就是打开一个带有标签的窗口，但在编写 MiniGtk 之后，我对 lablgtk 的作者有了新的敬佩！

MiniGtk 也是希望围绕他们最喜欢的 C 库编写 OCaml 绑定的人的良好教程。如果您曾经尝试为 Python 或 Java 编写绑定，您会发现对 OCaml 执行相同的操作出奇地容易，尽管您确实需要稍微担心一下垃圾回收器。

首先，让我们谈谈 MiniGtk 的结构：与其像 lablgtk 那样使用两层方法，我想使用单层（面向对象）方法来实现 MiniGtk。这意味着 MiniGtk 由一堆类定义组成。这些类中的方法几乎直接转换为对 C libgtk-1.2.so 库的调用。

我还想使 Gtk 的模块命名方案合理化。因此，只有一个名为（不出所料！）Gtk 的顶级模块，所有类都在此模块内部。测试程序如下所示

let win = new Gtk.window ~title:"My window" ();;
let lbl = new Gtk.label ~text:"Hello" ();;
win#add lbl;;

let () =
  Gtk.main ()

我定义了一个单一的抽象类型来涵盖所有 GtkObject（以及此 C 结构的“子类”）。在 Gtk 模块中，您将找到此类型定义

type obj

如上一章所述，这定义了一个抽象类型，无法创建任何实例。至少在 OCaml 中是这样。某些 C 函数将创建此类型的实例。例如，创建新标签（即 GtkLabel 结构）的函数是这样定义的

external gtk_label_new : string -> obj = "gtk_label_new_c"

这个奇怪的函数定义定义了一个外部函数，它来自 C。C 函数称为 gtk_label_new_c，它接收一个字符串并返回我们抽象的 obj 类型之一。

OCaml 还没有完全允许您调用任何 C 函数。您需要在库函数周围编写一个小的 C 包装器，以在 OCaml 的内部类型和 C 类型之间进行转换。gtk_label_new_c（注意额外的 _c）是我围绕名为 gtk_label_new 的真实 Gtk C 函数的包装器。它在这里。我稍后会详细解释。

CAMLprim value
gtk_label_new_c (value str)
{
  CAMLparam1 (str);
  CAMLreturn (wrap (GTK_OBJECT (
    gtk_label_new (String_val (str)))));
 }

在进一步解释此函数之前，我将退一步，看看我们 Gtk 类层次结构。我选择尽可能准确地反映实际的 Gtk 小部件层次结构。所有 Gtk 小部件都派生自一个称为 GtkObject 的虚拟基类。实际上，从这个类派生出 GtkWidget，并且各种 Gtk 小部件都派生自此。因此，我们定义了自己的 GtkObject 等效类，如下所示（请注意，object 是 OCaml 中的保留字）。

type obj

class virtual gtk_object (obj : obj) =
object (self)
  val obj = obj
  method obj = obj
end

type obj 定义了我们的抽象对象类型，而 class gtk_object 将其中一个“事物”作为其构造函数的参数。回想一下，此参数实际上是 C GtkObject 结构（实际上是指向此结构的特殊包装指针）。

您不能直接创建 gtk_object 实例，因为它是一个虚拟类，但是如果您能够创建它，则必须像这样构造它们：new gtk_object obj。您将传递什么作为该 obj 参数？您将传递例如 gtk_label_new 的返回值（返回查看该 external 函数是如何类型的）。如下所示

(* Example code, not really part of MiniGtk! *)
class label text =
  let obj = gtk_label_new text in
  object (self)
    inherit gtk_object obj
  end

当然，真正的 label 类不会像上面那样直接从 gtk_object 继承，但原则上它是这样工作的。

遵循 Gtk 类层次结构，唯一直接从 gtk_object 派生的类是我们的 widget 类，定义如下

external gtk_widget_show : obj -> unit = "gtk_widget_show_c"
external gtk_widget_show_all : obj -> unit = "gtk_widget_show_all_c"

class virtual widget ?show obj =
  object (self)
    inherit gtk_object obj
    method show = gtk_widget_show obj
    method show_all = gtk_widget_show_all obj
    initializer if show <> Some false then self#show
  end

这个类要复杂得多。让我们首先看一下初始化代码

class virtual widget ?show obj =
  object (self)
    inherit gtk_object obj
    initializer
      if show <> Some false then self#show
  end

initializer 部分您可能不太熟悉。这是在创建对象时运行的代码 - 等同于其他语言中的构造函数。在这种情况下，我们检查布尔可选 show 参数，除非用户将其显式指定为 false，否则我们会自动调用 #show 方法。（所有 Gtk 小部件在创建后都需要“显示”，除非您希望创建但隐藏的小部件）。

方法的实际定义是在几个外部函数的帮助下完成的。这些基本上是对 C 库的直接调用（实际上，确实有一点包装代码，但这在功能上并不重要）。

method show = gtk_widget_show obj
method show_all = gtk_widget_show_all obj

请注意，我们将底层的 GtkObject 传递给这两个 C 库调用。这是有道理的，因为这些函数在 C 中被原型化为 void gtk_widget_show (GtkWidget *);（在此上下文中，GtkWidget 和 GtkObject 可以安全地互换使用）。

我想描述 label 类（这次是真正的类！），但在 widget 和 label 之间是 misc，一个描述一大类杂项小部件的通用类。此类只是在小部件（如标签）周围添加填充和对齐。以下是它的定义

let may f x =
  match x with
  | None -> ()
  | Some x -> f x

external gtk_misc_set_alignment :
  obj -> float * float -> unit = "gtk_misc_set_alignment_c"
external gtk_misc_set_padding :
  obj -> int * int -> unit = "gtk_misc_set_padding_c"

class virtual misc ?alignment ?padding ?show obj =
  object (self)
    inherit widget ?show obj
    method set_alignment = gtk_misc_set_alignment obj
    method set_padding = gtk_misc_set_padding obj
    initializer
      may (gtk_misc_set_alignment obj) alignment;
      may (gtk_misc_set_padding obj) padding
  end

我们从一个名为 may : ('a -> unit) -> 'a option -> unit 的辅助函数开始，它在其第二个参数的内容上调用其第一个参数，除非第二个参数为 None。这个技巧（当然是从 lablgtk 那里偷来的）在处理可选参数时非常有用，我们将会看到。

misc 中的方法应该很简单。棘手的是初始化代码。首先请注意，我们将可选的 alignment 和 padding 参数传递给构造函数，并将可选的 show 和强制的 obj 参数直接传递给 widget。我们如何处理可选的 alignment 和 padding？初始化程序使用这些

initializer
  may (gtk_misc_set_alignment obj) alignment;
  may (gtk_misc_set_padding obj) padding

那就是棘手的 may 函数在起作用。如果用户给出了 alignment 参数，那么这将通过调用 gtk_misc_set_alignment obj the_alignment 来设置对象的对齐方式。但更常见的是，用户会省略 alignment 参数，在这种情况下 alignment 为 None，这不会做任何事情。（实际上，我们得到了 Gtk 的默认对齐方式，无论它是什么）。padding 也发生了类似的事情。请注意，执行此操作的方式具有一定的简洁性和优雅性。

现在我们终于可以进入 label 类了，它直接从 misc 派生

external gtk_label_new :
    string -> obj  = "gtk_label_new_c"
external gtk_label_set_text :
    obj -> string -> unit = "gtk_label_set_text_c"
external gtk_label_set_justify :
    obj -> Justification.t -> unit = "gtk_label_set_justify_c"
external gtk_label_set_pattern :
    obj -> string -> unit = "gtk_label_set_pattern_c"
external gtk_label_set_line_wrap :
    obj -> bool -> unit = "gtk_label_set_line_wrap_c"

class label ~text
  ?justify ?pattern ?line_wrap ?alignment
  ?padding ?show () =
  let obj = gtk_label_new text in
  object (self)
    inherit misc ?alignment ?padding ?show obj
    method set_text = gtk_label_set_text obj
    method set_justify = gtk_label_set_justify obj
    method set_pattern = gtk_label_set_pattern obj
    method set_line_wrap = gtk_label_set_line_wrap obj
    initializer
      may (gtk_label_set_justify obj) justify;
      may (gtk_label_set_pattern obj) pattern;
      may (gtk_label_set_line_wrap obj) line_wrap
  end

尽管这个类比我们之前看过的类要大，但实际上还是同一个概念，除了这个类不是虚拟类。您可以创建这个类的实例，这意味着它最终必须调用gtk_..._new。这是初始化代码（我们在上面讨论过这种模式）。

class label ~text ... () =
  let obj = gtk_label_new text in
  object (self)
    inherit misc ... obj
  end

（小测验：如果我们需要定义一个既是基类（其他类可以从中派生），又是用户可以创建实例的非虚拟类，该怎么办？）

包装对 C 库的调用

现在，我们将更详细地了解如何包装对 C 库函数的调用。这是一个简单的例子

/* external gtk_label_set_text :
     obj -> string -> unit
       = "gtk_label_set_text_c" */

CAMLprim value
gtk_label_set_text_c (value obj, value str)
{
  CAMLparam2 (obj, str);
  gtk_label_set_text (unwrap (GtkLabel, obj),
    String_val (str));
  CAMLreturn (Val_unit);
}

将 OCaml 对外部函数调用的原型（在注释中）与函数的定义进行比较，我们可以看到两件事

• OCaml 调用的 C 函数名为"gtk_label_set_text_c"。
• 传递两个参数（value obj 和 value str），并返回一个单元。

值是 OCaml 对各种事物的内部表示，从简单的整数到字符串，甚至包括对象。我不会详细介绍value类型，因为它在 OCaml 手册中有充分的介绍。要使用value，您只需要知道有哪些宏可用于在value和某些 C 类型之间进行转换。宏看起来像这样

`String_val (val)`

从已知为字符串的value转换为 C 字符串（即char *）。

`Val_unit`

OCaml 单元()作为value。

`Int_val (val)`

从已知为整数的value转换为 C int。

`Val_int (i)`

将 C 整数i转换为整数value。

`Bool_val (val)`

从已知为布尔值的value转换为 C 布尔值（即int）。

`Val_bool (i)`

将 C 整数i转换为布尔value。

您可以猜测其他内容或查阅手册。请注意，没有从 C char *到值的直接转换。这涉及分配内存，这有点复杂。

在上面的gtk_label_set_text_c中，external定义以及强类型和类型推断已经确保了参数具有正确的类型，因此要将value str转换为 C char *，我们调用了String_val (str)。

函数的其他部分有点奇怪。为了确保垃圾收集器“知道”您的 C 函数在 C 函数运行期间仍在使用obj和str（请记住，垃圾收集器可能会因许多事件（对 OCaml 的回调或使用 OCaml 的其中一个分配函数）而触发），您需要构建函数以添加代码来告诉垃圾收集器您正在使用的“根”。当然，还要在您完成使用这些根时告诉垃圾收集器。这是通过在CAMLparamN ... CAMLreturn中构建函数来完成的。因此

CAMLparam2 (obj, str);
...
CAMLreturn (Val_unit);

CAMLparam2是一个宏，表示您正在使用两个value参数。（还有另一个宏用于注释局部value变量）。您需要使用CAMLreturn而不是普通的return，这会告诉 GC 您已完成对这些根的使用。检查当您编写CAMLparam2 (obj, str)时内联的代码可能很有启发性。这是生成的代码（使用作者版本的 OCaml，因此在不同的实现之间可能略有不同）

struct caml__roots_block *caml__frame
    = local_roots;
struct caml__roots_block caml__roots_obj;

caml__roots_obj.next = local_roots;
local_roots = &caml__roots_obj;
caml__roots_obj.nitems = 1;
caml__roots_obj.ntables = 2;
caml__roots_obj.tables [0] = &obj;
caml__roots_obj.tables [1] = &str;

以及CAMLreturn (foo)

local_roots = caml__frame;
return (foo);

如果您仔细跟踪代码，您会发现local_roots显然是caml__roots_block结构的链接列表。当我们进入函数时，这些结构中的一种（或多种）会被推送到链接列表中，当我们离开时，所有这些都会被弹出，从而在离开函数时将local_roots恢复到其先前状态。（如果您记得调用CAMLreturn而不是return，否则local_roots最终会在堆栈上指向未初始化的数据，后果“非常有趣”）。

每个caml__roots_block结构最多可以容纳五个value（您可以有多个块，因此这不是限制）。当 GC 运行时，我们可以推断它必须遍历链接列表，从local_roots开始，并将每个value视为垃圾收集的根。不以这种方式声明value参数或局部value变量的后果是，垃圾收集器可能会将该变量视为不可达内存，并在您的函数运行时回收它！

最后是神秘的unwrap宏。这是我自己编写的，或者更确切地说，这是我大部分从 lablgtk 中复制的。有两个相关的函数，称为wrap和unwrap，正如您可能猜到的那样，它们在 OCaml value中包装和解包GtkObject。这些函数建立了GtkObject和我们为 OCaml 定义的不透明、神秘的obj类型之间的某种神奇关系（请参阅本章的第一部分以提醒自己）。

问题是如何将 C GtkObject结构包装起来（并隐藏起来），以便我们可以将其作为不透明的“事物”（obj）在我们的 OCaml 代码中传递，并希望稍后将其传递回可以解包它并重新获取同一个GtkObject的 C 函数？

为了将其传递给 OCaml 代码，我们必须以某种方式将其转换为value。幸运的是，我们可以很容易地使用 C API 创建 OCaml 垃圾收集器不会过于仔细检查的value块......