Racket FFI 2

λ included in racket ffi

2016-07-21 893 words 5 minutes

Contents

这是Racket的FFI的第二部分,这次还是会使用Cairo作为调用对象会涉及到FFI使用的时候更多的关于参数的部分,自定义返回值和如何使用c的结构体

前情提要

第一部分的内容会继续用到,将第一部分的内容整理如下

  
#lang racket
(require racket/draw
         racket/gui/base
         ffi/unsafe
         ffi/unsafe/define
         pict)

; bitmap magic
(define bt (make-bitmap 256 256))
(define bt-surface (send bt get-handle))

; C types
(define-cpointer-type _cairo_t)
(define-cpointer-type _cairo_surface_t)
(define _cairo_line_cap_t
  (_enum '(butt round square)))

(define cairo-lib (ffi-lib #f))
(define-ffi-definer define-cairo cairo-lib)

; the foreign functions
(define-cairo cairo-create
  (_fun _cairo_surface_t -> _cairo_t)
  #:c-id cairo_create)
(define-cairo cairo-move-to
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_move_to)
(define-cairo cairo-line-to
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_line_to)
(define-cairo cairo-set-line-width
  (_fun _cairo_t _double -> _void)
  #:c-id cairo_set_line_width)
(define-cairo cairo-stroke
  (_fun _cairo_t -> _void)
  #:c-id cairo_stroke)
(define-cairo cairo-set-line-cap
  (_fun _cairo_t _cairo_line_cap_t -> _void)
  #:c-id cairo_set_line_cap)

(define ctx (cairo-create bt-surface))

; Bitmap -> Pict
; a helper for displaying the bitmap
(define (show bt)
  (linewidth 2 (frame (bitmap bt))))'))

带有数组参数的函数调用

首先来看一下Cairo的sample page 上的一段画虚线的代码

double dashes[] = {50.0,  /* ink */
                   10.0,  /* skip */
                   10.0,  /* ink */
                   10.0   /* skip*/
                  };
int    ndash  = sizeof (dashes)/sizeof(dashes[0]);
double offset = -50.0;

cairo_set_dash (cr, dashes, ndash, offset);
cairo_set_line_width (cr, 10.0);

cairo_move_to (cr, 128.0, 25.6);
cairo_line_to (cr, 230.4, 230.4);
cairo_rel_line_to (cr, -102.4, 0.0);
cairo_curve_to (cr, 51.2, 230.4, 51.2, 128.0, 128.0, 128.0);

cairo_stroke (cr);

这里比较有意思的就是cairo_set_dash了,它需要一个数组作为参数.剩下的两个新增的函数和我们在第一部见到的并没有什么大的差别.简单的将他们转换为racket函数

(define-cairo cairo-rel-line-to
    (_fun _cairo_t _double _double -> _void)
    #:c-id cairo_rel_line_to)
(define-cairo cairo-curve-to
    (_fun _cairo_t
          _double _double
          _double _double
          _double _double
          -> _void)
    #:c-id cairo_curve_to)

与此同时,看看cairo_set_dash在c中是如何定义的

void cairo_set_dash (cairo_t *cr,
                     const double *dashes,
                     int num_dashes,
                     double offset);

这里的num_dashes指的是数组dashes的长度,在我们在转化为racket的函数的时候我们还会处理这个参数使我们调用函数的时候更加方便不容易出错. 从racket的角度来看,怎么表示一个数组呢?想来用list或者vector都会是比较容易想到的答案,用他们来表示数组也是挺自然的事情.那么可以做出如下定义

(define-cairo cairo-set-dash
    (_fun _cairo_t
          (_list i _double)
          _int
          _double
          -> _void)
    #:c-id cairo_set_dash)

这里出现了一个没见过的类型构造函数_list .这就是所谓的自定义函数类型,它在_fun里面有着特殊的意义._list可以让你在racket和c之间传递一个数组.因为数组类型经常出现的c的参数中,既可以作为函数的输入,有时候也用于存放函数的返回值,所以在使用_list构造函数的时候需要指定次数组的用途,输入,输出,或者都需要用到.因为我们只需要向其传递一个数组,所以这里选择的类型是i.

做好定义之后就可以想这样调用这个函数

(cairo-set-dash ctx
                (list 50.0 10.0 10.0 10.0)
                4
                -50.0)

之前提到的数组的长度,对于racket来说这似乎是一个没有必要的参数,当你拿到一个list之后当然很容易得到其长度,有必要在参数里面指明吗?这不仅繁琐,增加了工作量更导致了潜在的风险(需要人工设定数组的长度,人都是会犯错误的).

好在,_fun提供了一个不错的机制可以让我们计算出一个参数的值.它提供了(name : type)指定某个参数的名字以及其数据类型,还有(type = expr)用于设定某个参数的值.将其两者结合就可以自动得到数组的长度而不必每次都自己设定.具体代码如下

(define-cairo cairo-set-dash
    (_fun _cairo_t
          ;设定参数的名字以备后用
          [dashes : (_list i _double)]
          ;计算参数的值
          [_int = (length dashes)]
          _double
          -> _void)
    #:c-id cairo_set_dash)

如此以来,在调用cairo-set-dash函数的时候便再也不会因为数组的长度而犯错了.顺便一提,如果希望使用向量来代替链表来传递数组只要使用_vector构造方法即可.

都准备好了就试试看画点东西出来


(define dashes '(50.0 10.0 10.0 10.0))
(define offset -50.0)
(cairo-set-dash ctx dashes offset)
(cairo-set-line-width ctx 10.0)
(cairo-move-to ctx 128.0 25.6)
(cairo-line-to ctx 230.4 230.4)
(cairo-rel-line-to ctx -102.4 0.0)
(cairo-curve-to ctx 51.2 230.4 51.2
                    128.0 128.0 128.0)
(cairo-stroke ctx)
(show bt)

没有什么意外我们的结果大致看上去是这样的

返回参数和c结构体

为了演示一些FFI的高级用法,不妨设我们要向一个预设的空间写一些文字.更加确切地说我们有一个256x256的画布,现在想要在上面写一些文字.

(define txt-bt (make-bitmap 256 256))
(define txt-surface (send txt-bt get-handle))
(define txt-ctx (cairo-create txt-surface))

我们要做的是写这样一个函数,它接受一个字符串(我们假设我们的文字一行可以写下)将它画到一个位图上.因为这是任意的一个字符串,所以我们必须弄明白如何缩放这段字符串使其适应画布的大小.简单起见我们只考虑宽度,假设高度始终足够.

为了实现这关键的一步–测量字符串放入宽度,我们需要调用cairo的函数cairo_text_extends.其函数申明如下

void
cairo_text_extents (cairo_t *cr,
                    const char *utf8,
                    cairo_text_extents_t *extents);

这个申明的有趣之处在于其中包含了一个结构体类型cairo_text_extents_t,定义如下

/* from the Cairo docs */
typedef struct {
    double x_bearing;
    double y_bearing;
    double width;
    double height;
    double x_advance;
    double y_advance;
} cairo_text_extents_t;

到现在还不知道怎么支持c的结构体,不过不用担心,这并不复杂.如果你对于Racket的结构体的定义熟悉的话,这看上去应该比较面熟.

;;必须要有开头的下划线
(define-cstruct _cairo_text_extents_t
    ([x-bearing _double]
     [y-bearing _double]
     [width _double]
     [height _double]
     [x-advance _double]
     [y-advance _double]))

伴随这这个定义,我们还附带得到了一系列与之相关的函数

_cairo_text_extents_t — 结构体类型
_cairo_text_extents_t-pointer — 指向结构体的指针
_cairo_text_extents_t-pointer/null — 允许空指针

与Racket的struct非常了类似的是,附带还声明了一些操作函数

make-cairo_text_extents_t — 构造函数
cairo_text_extents_t-width — 选择函数
cairo_text_extents_t? — 谓词函数
set-cairo_text_extents_t-width! — 设定函数

现在可以方便的定义cairo-text-extends了

(define-cairo cairo-text-extents
    (_fun _cairo_t
              _string
                        _cairo_text_extents_t-pointer
                                  -> _void)
        #:c-id cairo_text_extents)

为了正真的使用这个函数,需要先申明一个结构体,传递给cairo-text-extends.

> (define extents
    (make-cairo_text_extents_t
         0.0 0.0 0.0 0.0 0.0 0.0))
> (cairo-text-extents
   txt-ctx "hello world" extents)
> (cairo_text_extents_t-width extents)
50.0

看上去我们不得不这么做,但是作为一门函数式编程语言,应该尽量避免对于变量的申明其实cario-text-extends可以有另一种写法来自定义返回值

(define-cairo cairo-text-extents*
    (_fun _cairo_t
          _string
          ;变量名 : 类型 _ptr
          [ext : (_ptr o _cairo_text_extents_t)]
          ; c语言的返回类型
          -> _void
          ; 自定义包装之后的函数的返回值
          -> ext)
    #:c-id cairo_text_extents)

此处的_ptr和之前的_list类似,因为ext使用做返回值所以这里的模式设置为o.在输出模式中这个类型会被自动实例化(使用malloc函数),并且作为指针传递出来.

比较奇怪的是,这里有两个->,其实看注释也可以明白了.

如此定义之后变可以轻松的写出我们之前要写的东西了,


(define-cairo cairo-show-text
  (_fun _cairo_t _string -> _void)
  #:c-id cairo_show_text)
 
(define-cairo cairo-scale
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_scale)
 
; String -> Void
; 水平的画出字符串
(define (fit-text str)
  (define padding 20)
  (cairo-move-to txt-ctx (/ padding 2.0) 128.0)
  (define extents
    (cairo-text-extents* txt-ctx str))
  (define x-bearing
    (cairo_text_extents_t-x-bearing
     extents))
  (define width
    (cairo_text_extents_t-width
     extents))
  (define scale (/ (- 256.0 padding)
                   (+ x-bearing width)))
  (cairo-scale txt-ctx scale scale)
  (cairo-show-text txt-ctx str))

最后一步

(fit-text "I'm Mr.λ")
(show txt-bt)

看看我们的成果吧

好了第二部分的FFI的使用就到这里.

附上完整的代码

#lang racket
(require racket/draw
         racket/gui/base
         ffi/unsafe
         ffi/unsafe/define
         pict)

; bitmap magic
(define bt (make-bitmap 256 256))
(define bt-surface (send bt get-handle))

; C type
(define-cpointer-type _cairo_t)
(define-cpointer-type _cairo_surface_t)
(define _cairo_line_cap_t
  (_enum '(butt round square)))

(define cairo-lib (ffi-lib #f))
(define-ffi-definer define-cairo cairo-lib)

; the foreign functions
(define-cairo cairo-create
  (_fun _cairo_surface_t -> _cairo_t)
  #:c-id cairo_create)
(define-cairo cairo-move-to
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_move_to)
(define-cairo cairo-line-to
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_line_to)
(define-cairo cairo-set-line-width
  (_fun _cairo_t _double -> _void)
  #:c-id cairo_set_line_width)
(define-cairo cairo-stroke
  (_fun _cairo_t -> _void)
  #:c-id cairo_stroke)
(define-cairo cairo-set-line-cap
  (_fun _cairo_t _cairo_line_cap_t -> _void)
  #:c-id cairo_set_line_cap)

(define ctx (cairo-create bt-surface))

; Bitmap -> Pict
; a helper for displaying the bitmap
(define (show bt)
  (linewidth 2 (frame (bitmap bt))))

(define-cairo cairo-rel-line-to
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_rel_line_to)
(define-cairo cairo-curve-to
  (_fun _cairo_t
        _double _double
        _double _double
        _double _double
        -> _void)
  #:c-id cairo_curve_to)

(define-cairo cairo-set-dash
    (_fun _cairo_t
          ; name this argument for later uses in the type
          [dashes : (_list i _double)]
          ; a computed argument position
          [_int = (length dashes)]
          _double
          -> _void)
    #:c-id cairo_set_dash)



(define dashes '(50.0 10.0 10.0 10.0))
(define offset -50.0)
(cairo-set-dash ctx dashes offset)
(cairo-set-line-width ctx 10.0)
(cairo-move-to ctx 128.0 25.6)
(cairo-line-to ctx 230.4 230.4)
(cairo-rel-line-to ctx -102.4 0.0)
(cairo-curve-to ctx 51.2 230.4 51.2
                    128.0 128.0 128.0)
(cairo-stroke ctx)
;; (show bt)

(define-cstruct _cairo_text_extents_t
    ([x-bearing _double]
     [y-bearing _double]
     [width _double]
     [height _double]
     [x-advance _double]
     [y-advance _double]))

(define-cairo cairo-text-extents*
  (_fun _cairo_t
        _string
        [ext :(_ptr o _cairo_text_extents_t)]
        -> _void
        -> ext)
  #:c-id cairo_text_extents)

(define-cairo cairo-show-text
  (_fun _cairo_t _string -> _void)
  #:c-id cairo_show_text)

(define-cairo cairo-scale
  (_fun _cairo_t _double _double -> _void)
  #:c-id cairo_scale)
(define txt-bt (make-bitmap 256 256))
(define txt-surface (send txt-bt get-handle))
(define txt-ctx (cairo-create txt-surface))
; String -> Void
; 水平的画出字符串
(define (fit-text str)
  (define padding 20)
  (cairo-move-to txt-ctx (/ padding 2.0) 128.0)
  (define extents
    (cairo-text-extents* txt-ctx str))
  (define x-bearing
    (cairo_text_extents_t-x-bearing
     extents))
  (define width
    (cairo_text_extents_t-width
     extents))
  (define scale (/ (- 256.0 padding)
                   (+ x-bearing width)))
  (cairo-scale txt-ctx scale scale)
  (cairo-show-text txt-ctx str))

(fit-text "I'm Mr.λ")
(show txt-bt)

后记:换到spacemacs写,体验还不错,但是稳定性奇差无比感觉完全和vim无法比.复制黏贴会卡,间歇性卡死.这篇博文的最后一百行左右,最后都已经写好了结果spacemacs卡住了,文件也没有保存,不是说好的auto-save呢.心情懊糟.重写之后和原来的有些差别,简略了挺多.比较不太明白的是为什么frog无法在markdown文件里面处理表格

First Header	Second Header
Content Cell	Content Cell
Content Cell	Content Cell