diff --git a/collects/racket/draw/private/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt index 91f6f5da9e..eb52532086 100644 --- a/collects/racket/draw/private/bitmap.rkt +++ b/collects/racket/draw/private/bitmap.rkt @@ -623,6 +623,8 @@ alpha-s)) (get-empty-surface))) + (define/public (get-handle) s) + (def/public (get-argb-pixels [exact-nonnegative-integer? x] [exact-nonnegative-integer? y] [exact-nonnegative-integer? w] diff --git a/collects/racket/draw/private/brush.rkt b/collects/racket/draw/private/brush.rkt index 2d5c495913..f49d9a3da0 100644 --- a/collects/racket/draw/private/brush.rkt +++ b/collects/racket/draw/private/brush.rkt @@ -1,6 +1,8 @@ #lang scheme/base (require scheme/class + ffi/unsafe ffi/unsafe/atomic + "../unsafe/cairo.rkt" "color.rkt" "syntax.rkt" "local.rkt" @@ -21,7 +23,9 @@ (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% (define key #f) @@ -118,7 +122,63 @@ [(make-or-false transformation-vector?) [t #f]]) (check-immutable 'set-stipple) (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))) ;; ---------------------------------------- diff --git a/collects/racket/draw/private/dc.rkt b/collects/racket/draw/private/dc.rkt index 27e692ac5d..fa643960d8 100644 --- a/collects/racket/draw/private/dc.rkt +++ b/collects/racket/draw/private/dc.rkt @@ -823,13 +823,15 @@ (send st get-width) (send st get-height) 0 0 mode col alpha #f) get-cairo-surface))])]) - (let* ([p (cairo_pattern_create_for_surface s)]) - (cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT) - (install-transformation transformation cr) - (cairo_set_source cr p) - (when transformation - (do-reset-matrix cr)) - (cairo_pattern_destroy p)))) + (install-surface s transformation))) + (define (install-surface s transformation) + (let* ([p (cairo_pattern_create_for_surface s)]) + (cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT) + (install-transformation transformation cr) + (cairo_set_source cr p) + (when transformation + (do-reset-matrix cr)) + (cairo_pattern_destroy p))) (cairo_set_antialias cr (case (dc-adjust-smoothing smoothing) [(unsmoothed) CAIRO_ANTIALIAS_NONE] [else CAIRO_ANTIALIAS_GRAY])) @@ -838,85 +840,100 @@ (unless (eq? 'transparent s) (let ([st (send brush get-stipple)] [col (send brush get-color)] - [gradient (send brush get-gradient)]) - (if (and gradient - (not (collapse-bitmap-b&w?))) - (make-gradient-pattern cr gradient (send brush get-transformation)) - (if st - (install-stipple st col s - (send brush get-transformation) - (lambda () brush-stipple-s) - (lambda (v) (set! brush-stipple-s v) v)) - (let ([horiz (lambda (cr2) - (cairo_move_to cr2 0 3.5) - (cairo_line_to cr2 12 3.5) - (cairo_move_to cr2 0 7.5) - (cairo_line_to cr2 12 7.5) - (cairo_move_to cr2 0 11.5) - (cairo_line_to cr2 12 11.5))] - [vert (lambda (cr2) - (cairo_move_to cr2 3.5 0) - (cairo_line_to cr2 3.5 12) - (cairo_move_to cr2 7.5 0) - (cairo_line_to cr2 7.5 12) - (cairo_move_to cr2 11.5 0) - (cairo_line_to cr2 11.5 12))] - [bdiag (lambda (cr2) - (for ([i (in-range -2 3)]) - (let ([y (* i 6)]) - (cairo_move_to cr2 -1 (+ -1 y)) - (cairo_line_to cr2 13 (+ 13 y)))))] - [fdiag (lambda (cr2) - (for ([i (in-range -2 3)]) - (let ([y (* i 6)]) - (cairo_move_to cr2 13 (+ -1 y)) - (cairo_line_to cr2 -1 (+ 13 y)))))]) - - (case s - [(horizontal-hatch) - (make-pattern-surface - cr col - horiz)] - [(vertical-hatch) - (make-pattern-surface - cr col - vert)] - [(cross-hatch) - (make-pattern-surface - cr col - (lambda (cr) (horiz cr) (vert cr)))] - [(bdiagonal-hatch) - (make-pattern-surface - cr col - 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)]))))) + [gradient (send brush get-gradient)] + [handle-info (send brush get-surface-handle-info)]) + (cond + [handle-info + (if (collapse-bitmap-b&w?) + ;; convert surface to a stipple: + (install-stipple (surface-handle-info->bitmap handle-info) col s + (send brush get-transformation) + (lambda () brush-stipple-s) + (lambda (v) (set! brush-stipple-s v) v)) + ;; normal use of surface: + (install-surface (vector-ref handle-info 0) + (send brush get-transformation)))] + [(and gradient + (not (collapse-bitmap-b&w?))) + (make-gradient-pattern cr gradient (send brush get-transformation))] + [st + (install-stipple st col s + (send brush get-transformation) + (lambda () brush-stipple-s) + (lambda (v) (set! brush-stipple-s v) v))] + [else + (let ([horiz (lambda (cr2) + (cairo_move_to cr2 0 3.5) + (cairo_line_to cr2 12 3.5) + (cairo_move_to cr2 0 7.5) + (cairo_line_to cr2 12 7.5) + (cairo_move_to cr2 0 11.5) + (cairo_line_to cr2 12 11.5))] + [vert (lambda (cr2) + (cairo_move_to cr2 3.5 0) + (cairo_line_to cr2 3.5 12) + (cairo_move_to cr2 7.5 0) + (cairo_line_to cr2 7.5 12) + (cairo_move_to cr2 11.5 0) + (cairo_line_to cr2 11.5 12))] + [bdiag (lambda (cr2) + (for ([i (in-range -2 3)]) + (let ([y (* i 6)]) + (cairo_move_to cr2 -1 (+ -1 y)) + (cairo_line_to cr2 13 (+ 13 y)))))] + [fdiag (lambda (cr2) + (for ([i (in-range -2 3)]) + (let ([y (* i 6)]) + (cairo_move_to cr2 13 (+ -1 y)) + (cairo_line_to cr2 -1 (+ 13 y)))))]) + + (case s + [(horizontal-hatch) + (make-pattern-surface + cr col + horiz)] + [(vertical-hatch) + (make-pattern-surface + cr col + vert)] + [(cross-hatch) + (make-pattern-surface + cr col + (lambda (cr) (horiz cr) (vert cr)))] + [(bdiagonal-hatch) + (make-pattern-surface + cr col + 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)))) (when pen? (let ([s (send pen get-style)]) (unless (eq? 'transparent s) (let ([st (send pen get-stipple)] [col (send pen get-color)]) - (if st - (install-stipple st col s - #f - (lambda () pen-stipple-s) - (lambda (v) (set! pen-stipple-s v) v)) - (install-color cr - (if (eq? s 'hilite) hilite-color col) - alpha - #f))) + (cond + [st + (install-stipple st col s + #f + (lambda () pen-stipple-s) + (lambda (v) (set! pen-stipple-s v) v))] + [else + (install-color cr + (if (eq? s 'hilite) hilite-color col) + alpha + #f)])) (cairo_set_line_width cr (let* ([v (send pen get-width)] [align? (aligned? smoothing)] [v (if align? diff --git a/collects/racket/draw/private/local.rkt b/collects/racket/draw/private/local.rkt index d23f5c549b..d1cdd0aa9b 100644 --- a/collects/racket/draw/private/local.rkt +++ b/collects/racket/draw/private/local.rkt @@ -1,7 +1,7 @@ #lang scheme/base (require scheme/class) -(provide (all-defined-out)) +(provide (protect-out (all-defined-out))) (define-local-member-name ;; various @@ -34,6 +34,9 @@ get-ps-pango get-font-key + ;; brush% + get-surface-handle-info + ;; dc-backend<%> get-cr release-cr diff --git a/collects/racket/draw/private/record-dc.rkt b/collects/racket/draw/private/record-dc.rkt index 0737745343..a4c3f5c041 100644 --- a/collects/racket/draw/private/record-dc.rkt +++ b/collects/racket/draw/private/record-dc.rkt @@ -104,34 +104,54 @@ (send the-pen-list find-or-create-pen color width style cap join))) (define (clone-brush b) - (let ([s (send b get-stipple)]) - (if s - (let ([b (make-object brush% - (send b get-color) - (send b get-style))] - [t (send b get-transformation)]) - (send b set-stipple (clone-bitmap s) t) - b) - (let ([g (send b get-gradient)]) - (if g - (make-object brush% - (send b get-color) - (send b get-style) - #f - g - (send b get-transformation)) - (send the-brush-list find-or-create-brush - (send b get-color) - (send b get-style))))))) + (cond + [(send b get-surface-handle-info) + => (lambda (hi) + (make-handle-brush (vector-ref hi 0) #:copy? #f + (vector-ref hi 1) + (vector-ref hi 2) + (send b get-transformation)))] + [(send b get-stipple) + => (lambda (s) + (let ([b (make-object brush% + (send b get-color) + (send b get-style))] + [t (send b get-transformation)]) + (send b set-stipple (clone-bitmap s) t) + b))] + [(send b get-gradient) + => (lambda (g) + (make-object brush% + (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) - (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)))) + (cond + [(send b get-surface-handle-info) + => (lambda (hi) + ;; Flatten the surface into a bitmap: + (define bm (surface-handle-info->bitmap hi)) + (let ([b (make-object brush% + (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-values (c style stipple gradient transformation) diff --git a/collects/racket/draw/unsafe/brush.rkt b/collects/racket/draw/unsafe/brush.rkt new file mode 100644 index 0000000000..26baa13a09 --- /dev/null +++ b/collects/racket/draw/unsafe/brush.rkt @@ -0,0 +1,5 @@ +#lang racket/base + +(require "../private/brush.rkt") +(provide make-handle-brush) + diff --git a/collects/racket/draw/unsafe/cairo-lib.rkt b/collects/racket/draw/unsafe/cairo-lib.rkt new file mode 100644 index 0000000000..d390f04dc7 --- /dev/null +++ b/collects/racket/draw/unsafe/cairo-lib.rkt @@ -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)) + diff --git a/collects/racket/draw/unsafe/cairo.rkt b/collects/racket/draw/unsafe/cairo.rkt index eeb2cc652d..17659bca84 100644 --- a/collects/racket/draw/unsafe/cairo.rkt +++ b/collects/racket/draw/unsafe/cairo.rkt @@ -2,35 +2,15 @@ (require ffi/unsafe ffi/unsafe/define ffi/unsafe/alloc + "cairo-lib.rkt" "../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")]) - (define-ffi-definer define-cairo cairo-lib #:provide provide-protected) (provide _cairo_t + _cairo_surface_t _cairo_font_options_t) (define _cairo_surface_t (_cpointer 'cairo_surface_t)) diff --git a/collects/scribblings/draw/bitmap-class.scrbl b/collects/scribblings/draw/bitmap-class.scrbl index 7d4c101bc3..cd6d27f497 100644 --- a/collects/scribblings/draw/bitmap-class.scrbl +++ b/collects/scribblings/draw/bitmap-class.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "common.rkt") +@(require "common.rkt" + (for-label (only-in ffi/unsafe cpointer?))) @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) exact-positive-integer?]{ diff --git a/collects/scribblings/draw/brush-class.scrbl b/collects/scribblings/draw/brush-class.scrbl index 8f2fc73b14..8b735f6ac3 100644 --- a/collects/scribblings/draw/brush-class.scrbl +++ b/collects/scribblings/draw/brush-class.scrbl @@ -1,5 +1,8 @@ #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)) @(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) (or/c (is-a?/c linear-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.} +@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) (one-of/c 'transparent 'solid 'opaque 'xor 'hilite 'panel diff --git a/collects/scribblings/draw/draw.scrbl b/collects/scribblings/draw/draw.scrbl index 3d6c1309ad..d7a96cec80 100644 --- a/collects/scribblings/draw/draw.scrbl +++ b/collects/scribblings/draw/draw.scrbl @@ -42,6 +42,7 @@ interface, and procedure bindings defined in this manual.} @include-section["svg-dc-class.scrbl"] @include-section["draw-funcs.scrbl"] @include-section["draw-unit.scrbl"] +@include-section["unsafe.scrbl"] @include-section["libs.scrbl"] @;------------------------------------------------------------------------ diff --git a/collects/scribblings/draw/unsafe.scrbl b/collects/scribblings/draw/unsafe.scrbl new file mode 100644 index 0000000000..a429a90e18 --- /dev/null +++ b/collects/scribblings/draw/unsafe.scrbl @@ -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.} + + diff --git a/collects/tests/gracket/draw.rkt b/collects/tests/gracket/draw.rkt index 9a37bba56c..74783b8408 100644 --- a/collects/tests/gracket/draw.rkt +++ b/collects/tests/gracket/draw.rkt @@ -1,4 +1,5 @@ #lang scheme/gui +(require "unsafe-draw.rkt") (define manual-chinese? #f) @@ -971,6 +972,12 @@ (send dc draw-rectangle 300 320 80 20) (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)]) (send dc set-pen "white" 1 'transparent) (send dc set-brush (new brush% diff --git a/collects/tests/gracket/unsafe-draw.rkt b/collects/tests/gracket/unsafe-draw.rkt new file mode 100644 index 0000000000..ff5b82cdf7 --- /dev/null +++ b/collects/tests/gracket/unsafe-draw.rkt @@ -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)