suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/draw: add get-handle' to bitmap%'; add `make-handle-brush'

Browse Source 
The `get-handle' method provides the underlying Cairo surface for
a bitmap, while the unsafe `make-handle-brush' function supports the
use of a Cairo surface as a `brush%'.

Also, add `racket/draw/unsafe/cairo-lib', which simplifies access
Cairo from external libraries. Documenting `racket/draw/unsafe/cairo'
might be better, but that's a lot more work.
This commit is contained in:
Matthew Flatt 2012-03-27 17:53:49 -06:00
parent 4735666cd9
commit 4f197f4ba9
14 changed files with 380 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/draw/private/bitmap.rkt
View File

@ -623,6 +623,8 @@
alpha-s)) alpha-s))
(get-empty-surface))) (get-empty-surface)))
(define/public (get-handle) s)
(def/public (get-argb-pixels [exact-nonnegative-integer? x] (def/public (get-argb-pixels [exact-nonnegative-integer? x]
[exact-nonnegative-integer? y] [exact-nonnegative-integer? y]
[exact-nonnegative-integer? w] [exact-nonnegative-integer? w]

64
collects/racket/draw/private/brush.rkt
View File

@ -1,6 +1,8 @@
#lang scheme/base #lang scheme/base
(require scheme/class (require scheme/class
ffi/unsafe
ffi/unsafe/atomic ffi/unsafe/atomic
"../unsafe/cairo.rkt"
"color.rkt" "color.rkt"
"syntax.rkt" "syntax.rkt"
"local.rkt" "local.rkt"
@ -21,7 +23,9 @@
(define black (send the-color-database find-color "black")) (define black (send the-color-database find-color "black"))
(define-local-member-name s-set-key) (define-local-member-name
s-set-key
set-surface-handle-info)
(defclass brush% object% (defclass brush% object%
(define key #f) (define key #f)
@ -118,7 +122,63 @@
[(make-or-false transformation-vector?) [t #f]]) [(make-or-false transformation-vector?) [t #f]])
(check-immutable 'set-stipple) (check-immutable 'set-stipple)
(set! stipple s) (set! stipple s)
(set! transformation (and s t)))) (set! transformation (and s t)))
(define surface-handle #f)
(define/public (get-surface-handle-info) surface-handle) ; local
(def/public (get-handle) (and surface-handle
(vector-ref surface-handle 0)))
(define/public (set-surface-handle-info h t)
(set! surface-handle h)
(set! transformation t)))
;; unsafe (and so exported by `racket/draw/unsafe/brush'):
(provide (protect-out make-handle-brush))
(define (make-handle-brush handle width height [t #f]
#:copy? [copy? #t])
;; for argument checking:
(define/top (make-handle-brush [cpointer? handle]
[exact-nonnegative-integer? width]
[exact-nonnegative-integer? height]
[(make-or-false transformation-vector?) t])
'ok)
(make-handle-brush handle width height t)
;; arguments are ok, so proceed:
(define s-in (cast handle _pointer _cairo_surface_t))
(define s
(if copy?
(let ()
(define s (cairo_surface_create_similar s-in CAIRO_CONTENT_COLOR_ALPHA width height))
(define cr (cairo_create s))
(let* ([p (cairo_pattern_create_for_surface s-in)])
(cairo_set_source cr p)
(cairo_pattern_destroy p)
(cairo_rectangle cr 0 0 width height)
(cairo_fill cr)
(cairo_destroy cr))
s)
s-in))
(define b (new brush%))
(send b set-surface-handle-info (vector s width height #f) t)
b)
(provide (protect-out surface-handle-info->bitmap))
(define (surface-handle-info->bitmap hi)
(or (vector-ref hi 3)
(let ()
(define width (vector-ref hi 1))
(define height (vector-ref hi 2))
(define bm (make-bitmap width height))
(define s (send bm get-cairo-surface))
(define cr (cairo_create s))
(let* ([p (cairo_pattern_create_for_surface (vector-ref hi 0))])
(cairo_set_source cr p)
(cairo_pattern_destroy p)
(cairo_rectangle cr 0 0 width height)
(cairo_fill cr)
(cairo_destroy cr))
(vector-set! hi 3 bm)
bm)))
;; ---------------------------------------- ;; ----------------------------------------

177
collects/racket/draw/private/dc.rkt
View File

@ -823,13 +823,15 @@
(send st get-width) (send st get-height) (send st get-width) (send st get-height)
0 0 mode col alpha #f) 0 0 mode col alpha #f)
get-cairo-surface))])]) get-cairo-surface))])])
(let* ([p (cairo_pattern_create_for_surface s)]) (install-surface s transformation)))
(cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT) (define (install-surface s transformation)
(install-transformation transformation cr) (let* ([p (cairo_pattern_create_for_surface s)])
(cairo_set_source cr p) (cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT)
(when transformation (install-transformation transformation cr)
(do-reset-matrix cr)) (cairo_set_source cr p)
(cairo_pattern_destroy p)))) (when transformation
(do-reset-matrix cr))
(cairo_pattern_destroy p)))
(cairo_set_antialias cr (case (dc-adjust-smoothing smoothing) (cairo_set_antialias cr (case (dc-adjust-smoothing smoothing)
[(unsmoothed) CAIRO_ANTIALIAS_NONE] [(unsmoothed) CAIRO_ANTIALIAS_NONE]
[else CAIRO_ANTIALIAS_GRAY])) [else CAIRO_ANTIALIAS_GRAY]))
@ -838,85 +840,100 @@
(unless (eq? 'transparent s) (unless (eq? 'transparent s)
(let ([st (send brush get-stipple)] (let ([st (send brush get-stipple)]
[col (send brush get-color)] [col (send brush get-color)]
[gradient (send brush get-gradient)]) [gradient (send brush get-gradient)]
(if (and gradient [handle-info (send brush get-surface-handle-info)])
(not (collapse-bitmap-b&w?))) (cond
(make-gradient-pattern cr gradient (send brush get-transformation)) [handle-info
(if st (if (collapse-bitmap-b&w?)
(install-stipple st col s ;; convert surface to a stipple:
(send brush get-transformation) (install-stipple (surface-handle-info->bitmap handle-info) col s
(lambda () brush-stipple-s) (send brush get-transformation)
(lambda (v) (set! brush-stipple-s v) v)) (lambda () brush-stipple-s)
(let ([horiz (lambda (cr2) (lambda (v) (set! brush-stipple-s v) v))
(cairo_move_to cr2 0 3.5) ;; normal use of surface:
(cairo_line_to cr2 12 3.5) (install-surface (vector-ref handle-info 0)
(cairo_move_to cr2 0 7.5) (send brush get-transformation)))]
(cairo_line_to cr2 12 7.5) [(and gradient
(cairo_move_to cr2 0 11.5) (not (collapse-bitmap-b&w?)))
(cairo_line_to cr2 12 11.5))] (make-gradient-pattern cr gradient (send brush get-transformation))]
[vert (lambda (cr2) [st
(cairo_move_to cr2 3.5 0) (install-stipple st col s
(cairo_line_to cr2 3.5 12) (send brush get-transformation)
(cairo_move_to cr2 7.5 0) (lambda () brush-stipple-s)
(cairo_line_to cr2 7.5 12) (lambda (v) (set! brush-stipple-s v) v))]
(cairo_move_to cr2 11.5 0) [else
(cairo_line_to cr2 11.5 12))] (let ([horiz (lambda (cr2)
[bdiag (lambda (cr2) (cairo_move_to cr2 0 3.5)
(for ([i (in-range -2 3)]) (cairo_line_to cr2 12 3.5)
(let ([y (* i 6)]) (cairo_move_to cr2 0 7.5)
(cairo_move_to cr2 -1 (+ -1 y)) (cairo_line_to cr2 12 7.5)
(cairo_line_to cr2 13 (+ 13 y)))))] (cairo_move_to cr2 0 11.5)
[fdiag (lambda (cr2) (cairo_line_to cr2 12 11.5))]
(for ([i (in-range -2 3)]) [vert (lambda (cr2)
(let ([y (* i 6)]) (cairo_move_to cr2 3.5 0)
(cairo_move_to cr2 13 (+ -1 y)) (cairo_line_to cr2 3.5 12)
(cairo_line_to cr2 -1 (+ 13 y)))))]) (cairo_move_to cr2 7.5 0)
(cairo_line_to cr2 7.5 12)
(case s (cairo_move_to cr2 11.5 0)
[(horizontal-hatch) (cairo_line_to cr2 11.5 12))]
(make-pattern-surface [bdiag (lambda (cr2)
cr col (for ([i (in-range -2 3)])
horiz)] (let ([y (* i 6)])
[(vertical-hatch) (cairo_move_to cr2 -1 (+ -1 y))
(make-pattern-surface (cairo_line_to cr2 13 (+ 13 y)))))]
cr col [fdiag (lambda (cr2)
vert)] (for ([i (in-range -2 3)])
[(cross-hatch) (let ([y (* i 6)])
(make-pattern-surface (cairo_move_to cr2 13 (+ -1 y))
cr col (cairo_line_to cr2 -1 (+ 13 y)))))])
(lambda (cr) (horiz cr) (vert cr)))]
[(bdiagonal-hatch) (case s
(make-pattern-surface [(horizontal-hatch)
cr col (make-pattern-surface
bdiag)] cr col
[(fdiagonal-hatch) horiz)]
(make-pattern-surface [(vertical-hatch)
cr col (make-pattern-surface
fdiag)] cr col
[(crossdiag-hatch) vert)]
(make-pattern-surface [(cross-hatch)
cr col (make-pattern-surface
(lambda (cr) (bdiag cr) (fdiag cr)))] cr col
[else (lambda (cr) (horiz cr) (vert cr)))]
(install-color cr [(bdiagonal-hatch)
(if (eq? s 'hilite) hilite-color col) (make-pattern-surface
alpha cr col
#f)]))))) bdiag)]
[(fdiagonal-hatch)
(make-pattern-surface
cr col
fdiag)]
[(crossdiag-hatch)
(make-pattern-surface
cr col
(lambda (cr) (bdiag cr) (fdiag cr)))]
[else
(install-color cr
(if (eq? s 'hilite) hilite-color col)
alpha
#f)]))]))
(cairo_fill_preserve cr)))) (cairo_fill_preserve cr))))
(when pen? (when pen?
(let ([s (send pen get-style)]) (let ([s (send pen get-style)])
(unless (eq? 'transparent s) (unless (eq? 'transparent s)
(let ([st (send pen get-stipple)] (let ([st (send pen get-stipple)]
[col (send pen get-color)]) [col (send pen get-color)])
(if st (cond
(install-stipple st col s [st
#f (install-stipple st col s
(lambda () pen-stipple-s) #f
(lambda (v) (set! pen-stipple-s v) v)) (lambda () pen-stipple-s)
(install-color cr (lambda (v) (set! pen-stipple-s v) v))]
(if (eq? s 'hilite) hilite-color col) [else
alpha (install-color cr
#f))) (if (eq? s 'hilite) hilite-color col)
alpha
#f)]))
(cairo_set_line_width cr (let* ([v (send pen get-width)] (cairo_set_line_width cr (let* ([v (send pen get-width)]
[align? (aligned? smoothing)] [align? (aligned? smoothing)]
[v (if align? [v (if align?

5
collects/racket/draw/private/local.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/class) (require scheme/class)
(provide (all-defined-out)) (provide (protect-out (all-defined-out)))
(define-local-member-name (define-local-member-name
;; various ;; various
@ -34,6 +34,9 @@
get-ps-pango get-ps-pango
get-font-key get-font-key
;; brush%
get-surface-handle-info
;; dc-backend<%> ;; dc-backend<%>
get-cr get-cr
release-cr release-cr

72
collects/racket/draw/private/record-dc.rkt
View File

@ -104,34 +104,54 @@
(send the-pen-list find-or-create-pen color width style cap join))) (send the-pen-list find-or-create-pen color width style cap join)))
(define (clone-brush b) (define (clone-brush b)
(let ([s (send b get-stipple)]) (cond
(if s [(send b get-surface-handle-info)
(let ([b (make-object brush% => (lambda (hi)
(send b get-color) (make-handle-brush (vector-ref hi 0) #:copy? #f
(send b get-style))] (vector-ref hi 1)
[t (send b get-transformation)]) (vector-ref hi 2)
(send b set-stipple (clone-bitmap s) t) (send b get-transformation)))]
b) [(send b get-stipple)
(let ([g (send b get-gradient)]) => (lambda (s)
(if g (let ([b (make-object brush%
(make-object brush% (send b get-color)
(send b get-color) (send b get-style))]
(send b get-style) [t (send b get-transformation)])
#f (send b set-stipple (clone-bitmap s) t)
g b))]
(send b get-transformation)) [(send b get-gradient)
(send the-brush-list find-or-create-brush => (lambda (g)
(send b get-color) (make-object brush%
(send b get-style))))))) (send b get-color)
(send b get-style)
#f
g
(send b get-transformation)))]
[else
(send the-brush-list find-or-create-brush
(send b get-color)
(send b get-style))]))
(define (convert-brush b) (define (convert-brush b)
(let ([s (send b get-stipple)] (cond
[g (send b get-gradient)]) [(send b get-surface-handle-info)
(list (convert-color (send b get-color)) => (lambda (hi)
(send b get-style) ;; Flatten the surface into a bitmap:
(and s (convert-bitmap s)) (define bm (surface-handle-info->bitmap hi))
(and g (convert-gradient g)) (let ([b (make-object brush%
(send b get-transformation)))) (send b get-color)
(send b get-style))]
[t (send b get-transformation)])
(send b set-stipple bm t)
(convert-brush b)))]
[else
(let ([s (send b get-stipple)]
[g (send b get-gradient)])
(list (convert-color (send b get-color))
(send b get-style)
(and s (convert-bitmap s))
(and g (convert-gradient g))
(send b get-transformation)))]))
(define (unconvert-brush l) (define (unconvert-brush l)
(define-values (c style stipple gradient transformation) (define-values (c style stipple gradient transformation)

5
collects/racket/draw/unsafe/brush.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang racket/base
(require "../private/brush.rkt")
(provide make-handle-brush)

31
collects/racket/draw/unsafe/cairo-lib.rkt Normal file
View File

@ -0,0 +1,31 @@
#lang scheme/base
(require ffi/unsafe
ffi/unsafe/define
ffi/unsafe/alloc
"../private/libs.rkt"
"../private/utils.rkt")
(define-runtime-lib cairo-lib
[(unix) (ffi-lib "libcairo" '("2" ""))]
[(macosx)
(ffi-lib "libpixman-1.0.dylib")
(ffi-lib "libpng15.15.dylib")
(ffi-lib "libcairo.2.dylib")]
[(win32)
(ffi-lib "zlib1.dll")
(ffi-lib "libpng14-14.dll")
(ffi-lib "libexpat-1.dll")
(ffi-lib "freetype6.dll")
(ffi-lib "libfontconfig-1.dll")
(ffi-lib "libcairo-2.dll")]
[(win64)
(ffi-lib "zlib1.dll")
(ffi-lib "libintl-8.dll")
(ffi-lib "libpng14-14.dll")
(ffi-lib "libexpat-1.dll")
(ffi-lib "libfreetype-6.dll")
(ffi-lib "libfontconfig-1.dll")
(ffi-lib "libcairo-2.dll")])
(provide (protect-out cairo-lib))

24
collects/racket/draw/unsafe/cairo.rkt
View File

@ -2,35 +2,15 @@
(require ffi/unsafe (require ffi/unsafe
ffi/unsafe/define ffi/unsafe/define
ffi/unsafe/alloc ffi/unsafe/alloc
"cairo-lib.rkt"
"../private/libs.rkt" "../private/libs.rkt"
"../private/utils.rkt") "../private/utils.rkt")
(define-runtime-lib cairo-lib
[(unix) (ffi-lib "libcairo" '("2" ""))]
[(macosx)
(ffi-lib "libpixman-1.0.dylib")
(ffi-lib "libpng15.15.dylib")
(ffi-lib "libcairo.2.dylib")]
[(win32)
(ffi-lib "zlib1.dll")
(ffi-lib "libpng14-14.dll")
(ffi-lib "libexpat-1.dll")
(ffi-lib "freetype6.dll")
(ffi-lib "libfontconfig-1.dll")
(ffi-lib "libcairo-2.dll")]
[(win64)
(ffi-lib "zlib1.dll")
(ffi-lib "libintl-8.dll")
(ffi-lib "libpng14-14.dll")
(ffi-lib "libexpat-1.dll")
(ffi-lib "libfreetype-6.dll")
(ffi-lib "libfontconfig-1.dll")
(ffi-lib "libcairo-2.dll")])
(define-ffi-definer define-cairo cairo-lib (define-ffi-definer define-cairo cairo-lib
#:provide provide-protected) #:provide provide-protected)
(provide _cairo_t (provide _cairo_t
_cairo_surface_t
_cairo_font_options_t) _cairo_font_options_t)
(define _cairo_surface_t (_cpointer 'cairo_surface_t)) (define _cairo_surface_t (_cpointer 'cairo_surface_t))

12
collects/scribblings/draw/bitmap-class.scrbl
View File

@ -1,5 +1,6 @@
#lang scribble/doc #lang scribble/doc
@(require "common.rkt") @(require "common.rkt"
(for-label (only-in ffi/unsafe cpointer?)))
@defclass/title[bitmap% object% ()]{ @defclass/title[bitmap% object% ()]{
@ -84,6 +85,15 @@ monochrome bitmap and @racket[32] for a color bitmap. See also
} }
@defmethod[(get-handle) cpointer?]{
Returns a low-level handle to the bitmap content. Currently, on all
platforms, a handle is a @tt{cairo_surface_t}. For a bitmap created
with @racket[make-bitmap], the handle is specifically a Cairo
image surface.}
@defmethod[(get-height) @defmethod[(get-height)
exact-positive-integer?]{ exact-positive-integer?]{

23
collects/scribblings/draw/brush-class.scrbl
View File

@ -1,5 +1,8 @@
#lang scribble/doc #lang scribble/doc
@(require "common.rkt" scribble/eval) @(require "common.rkt"
scribble/eval
(for-label racket/draw/unsafe/brush
(only-in ffi/unsafe cpointer?)))
@(define class-eval (make-base-eval)) @(define class-eval (make-base-eval))
@(interaction-eval #:eval class-eval (require racket/class racket/draw)) @(interaction-eval #:eval class-eval (require racket/class racket/draw))
@ -118,12 +121,6 @@ Returns the brush's color.
} }
@defmethod[(get-stipple)
(or/c (is-a?/c bitmap%) #f)]{
Gets the @tech{brush stipple} bitmap, or @racket[#f] if the brush has no stipple.}
@defmethod[(get-gradient) @defmethod[(get-gradient)
(or/c (is-a?/c linear-gradient%) (or/c (is-a?/c linear-gradient%)
(is-a?/c radial-gradient%) (is-a?/c radial-gradient%)
@ -132,6 +129,18 @@ Gets the @tech{brush stipple} bitmap, or @racket[#f] if the brush has no stipple
Gets the @tech{gradient}, or @racket[#f] if the brush has no gradient.} Gets the @tech{gradient}, or @racket[#f] if the brush has no gradient.}
@defmethod[(get-handle) (or/c cpointer? #f)]{
Returns a low-level handle for the brush content, but only for brushes
created with @racket[make-handle-brush]; otherwise, the result is @racket[#f].}
@defmethod[(get-stipple)
(or/c (is-a?/c bitmap%) #f)]{
Gets the @tech{brush stipple} bitmap, or @racket[#f] if the brush has no stipple.}
@defmethod[(get-style) @defmethod[(get-style)
(one-of/c 'transparent 'solid 'opaque (one-of/c 'transparent 'solid 'opaque
'xor 'hilite 'panel 'xor 'hilite 'panel

1
collects/scribblings/draw/draw.scrbl
View File

@ -42,6 +42,7 @@ interface, and procedure bindings defined in this manual.}
@include-section["svg-dc-class.scrbl"] @include-section["svg-dc-class.scrbl"]
@include-section["draw-funcs.scrbl"] @include-section["draw-funcs.scrbl"]
@include-section["draw-unit.scrbl"] @include-section["draw-unit.scrbl"]
@include-section["unsafe.scrbl"]
@include-section["libs.scrbl"] @include-section["libs.scrbl"]
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------

60
collects/scribblings/draw/unsafe.scrbl Normal file
View File

@ -0,0 +1,60 @@
#lang scribble/doc
@(require "common.rkt"
(for-label (except-in ffi/unsafe ->)
racket/draw/unsafe/brush
racket/draw/unsafe/cairo-lib))
@title[#:tag "unsafe"]{Unsafe Libraries}
The @racketmodname[racket/draw] library is currently implemented using Cairo
and Pango. The @xmethod[bitmap% get-handle] method exposes the
underlying Cairo surface for a @racket[bitmap%] object, while
@racket[make-handle-brush] supports the creation of a brush from an
existing Cairo surface. The representation of handles for these
methods, however, is subject to change if the @racketmodname[racket/draw]
library is implemented differently in the future.
@section{Handle Brushes}
@defmodule[racket/draw/unsafe/brush]
@defproc[(make-handle-brush [handle cpointer?]
[width exact-nonnegative-integer?]
[height exact-nonnegative-integer?]
[transformation (or/c #f (vector/c (vector/c real? real? real?
real? real? real?)
real? real? real? real? real?))]
[#:copy? copy? any/c #t])
(is-a?/c brush%)]{
Creates a brush given a @racket[handle] that (currently) is a
@tt{cairo_surface_t}. If @racket[copy?] is true, then the surface is
copied, so that it can be freed or modified after the brush is
created; if @racket[copy?] is @racket[#f], the surface must remain available
and unchanged as long as the brush can be used.
The @racket[width] and @racket[height] arguments specify the surface
bounds for use when the surface must be copied---even when
@racket[copy?] is @racket[#f]. The surface may need to be converted to a
stipple bitmap, for example, when drawing to a monochrome target.
The given surface is treated much like a stipple bitmap: it is
implicitly repeated, and the given @racket[transformation] (if any)
determines the surface's alignment relative to the target drawing
context.
When the brush is used with a @racket[record-dc%] object, and if that
object's @method[record-dc% get-recorded-datum] method is called, then the
surface is effectively converted to a stipple bitmap for the result datum.}
@section{Cairo Library}
@defmodule[racket/draw/unsafe/cairo-lib]
@defthing[cairo-lib (or/c ffi-lib? #f)]{
A reference to the Cairo library for use with functions such as
@racket[get-ffi-obj], or @racket[#f] if Cairo is unavailable.}

7
collects/tests/gracket/draw.rkt
View File

@ -1,4 +1,5 @@
#lang scheme/gui #lang scheme/gui
(require "unsafe-draw.rkt")
(define manual-chinese? #f) (define manual-chinese? #f)
@ -971,6 +972,12 @@
(send dc draw-rectangle 300 320 80 20) (send dc draw-rectangle 300 320 80 20)
(send dc set-pen p)) (send dc set-pen p))
(let ([p (send dc get-pen)])
(send dc set-pen "black" 1 'solid)
(send dc set-brush surface-brush)
(send dc draw-rectangle 400 320 30 40)
(send dc set-pen p))
(let ([p (send dc get-pen)]) (let ([p (send dc get-pen)])
(send dc set-pen "white" 1 'transparent) (send dc set-pen "white" 1 'transparent)
(send dc set-brush (new brush% (send dc set-brush (new brush%

36
collects/tests/gracket/unsafe-draw.rkt Normal file
View File

@ -0,0 +1,36 @@
#lang racket/base
(require ffi/unsafe
racket/draw/unsafe/cairo-lib
racket/draw/unsafe/brush)
(provide surface-brush)
(define cairo_image_surface_create
(get-ffi-obj 'cairo_image_surface_create cairo-lib (_fun _int _int _int -> _pointer)))
(define cairo_surface_destroy
(get-ffi-obj 'cairo_surface_destroy cairo-lib (_fun _pointer -> _void)))
(define cairo_create
(get-ffi-obj 'cairo_create cairo-lib (_fun _pointer -> _pointer)))
(define cairo_destroy
(get-ffi-obj 'cairo_destroy cairo-lib (_fun _pointer -> _void)))
(define cairo_set_source_rgba
(get-ffi-obj 'cairo_set_source_rgba cairo-lib (_fun _pointer _double* _double* _double* _double* -> _void)))
(define cairo_rectangle
(get-ffi-obj 'cairo_rectangle cairo-lib (_fun _pointer _double* _double* _double* _double* -> _void)))
(define cairo_fill
(get-ffi-obj 'cairo_fill cairo-lib (_fun _pointer -> _void)))
(define s (cairo_image_surface_create 0 20 30))
(define cr (cairo_create s))
(cairo_set_source_rgba cr 1.0 0.0 0.0 0.5)
(cairo_rectangle cr 2 2 16 26)
(cairo_fill cr)
(cairo_set_source_rgba cr 0.0 0.0 0.0 1.0)
(cairo_rectangle cr 9 9 2 2)
(cairo_fill cr)
(cairo_destroy cr)
(define surface-brush (make-handle-brush s 20 30 '#(#(1 0 0 1 420 320) 0 0 1 1 0)))
(cairo_surface_destroy s)