diff --git a/draw-lib/info.rkt b/draw-lib/info.rkt index 61d14c1..6bb557f 100644 --- a/draw-lib/info.rkt +++ b/draw-lib/info.rkt @@ -17,4 +17,4 @@ (define pkg-authors '(mflatt)) -(define version "1.15") +(define version "1.16") diff --git a/draw-lib/racket/draw/private/dc-intf.rkt b/draw-lib/racket/draw/private/dc-intf.rkt index 286824f..0ae5db6 100644 --- a/draw-lib/racket/draw/private/dc-intf.rkt +++ b/draw-lib/racket/draw/private/dc-intf.rkt @@ -33,6 +33,7 @@ 'horizontal-hatch 'vertical-hatch)) (define dc<%> + (let ([is-a-dc<%>/c (recursive-contract (is-a?/c dc<%>) #:flat)]) (interface () [cache-font-metrics-key (->m exact-integer?)] [clear (->m void?)] @@ -65,6 +66,7 @@ (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) void?)] + [draw-layer (->*m [is-a-dc<%>/c] [real? real?] void?)] [draw-line (->m real? real? real? real? void?)] @@ -135,6 +137,7 @@ real? real? real?) real? real? real? real? real?))] [glyph-exists? (->m char? boolean?)] + [make-layer (->m is-a-dc<%>/c)] [ok? (->m boolean?)] [resume-flush (->m void?)] [rotate (->m real? void?)] @@ -177,4 +180,4 @@ [transform (->m (vector/c real? real? real? real? real? real?) void?)] [translate (->m real? real? void?)] - [try-color (->m (is-a?/c color%) (is-a?/c color%) void?)])) + [try-color (->m (is-a?/c color%) (is-a?/c color%) void?)]))) diff --git a/draw-lib/racket/draw/private/dc.rkt b/draw-lib/racket/draw/private/dc.rkt index fc59f82..3659831 100644 --- a/draw-lib/racket/draw/private/dc.rkt +++ b/draw-lib/racket/draw/private/dc.rkt @@ -26,6 +26,8 @@ (provide dc-mixin dc-backend<%> default-dc-backend% + layer-dc-backend<%> + layer-mixin do-set-pen! do-set-brush! (protect-out set-font-map-init-hook!)) @@ -857,6 +859,11 @@ (loop x y (- w dx) h x2 y2)])])) (cairo_set_operator cr CAIRO_OPERATOR_OVER))))) + (define/private (install-smoothing cr) + (cairo_set_antialias cr (case (dc-adjust-smoothing smoothing) + [(unsmoothed) CAIRO_ANTIALIAS_NONE] + [else CAIRO_ANTIALIAS_GRAY]))) + (define/private (make-pattern-surface cr col draw) (let* ([s (cairo_surface_create_similar (cairo_get_target cr) CAIRO_CONTENT_COLOR_ALPHA @@ -865,9 +872,7 @@ (install-color cr2 col alpha #f) (cairo_set_line_width cr2 1) (cairo_set_line_cap cr CAIRO_LINE_CAP_ROUND) - (cairo_set_antialias cr2 (case (dc-adjust-smoothing smoothing) - [(unsmoothed) CAIRO_ANTIALIAS_NONE] - [else CAIRO_ANTIALIAS_GRAY])) + (install-smoothing cr2) (draw cr2) (cairo_stroke cr2) (cairo_destroy cr2) @@ -944,9 +949,7 @@ (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])) + (install-smoothing cr) (when brush? (let ([s (send brush get-style)]) (unless (eq? 'transparent s) @@ -2119,10 +2122,92 @@ (s-sel (cairo_matrix_t-xx mx) (cairo_matrix_t-yy mx))))))))) + (define/pubment (make-layer) + (define layer (inner (new surface-layer-dc% [owner this]) make-layer)) + (send layer set-pen pen) + (send layer set-brush brush) + (send layer set-font font) + (send layer set-text-foreground text-fg) + (send layer set-text-background text-bg) + (send layer set-alignment-scale alignment-scale) + (send layer set-smoothing smoothing) + layer) + + (def/public (draw-layer [dc<%> layer] [real? [x 0]] [real? [y 0]]) + (unless (and (is-a? layer layer-dc-backend<%>) + (object=? this (send layer get-owner))) + (raise-arguments-error (method-name 'dc<%> 'draw-layer) + (string-append "the given dc<%> does not belong to this dc<%>;\n" + " it must have been created by a call to make-layer" + " on this object"))) + (draw-owned-layer layer x y)) + + (define/public (draw-owned-layer layer x y) + (define surface (send layer get-cairo-surface)) + (with-cr + (check-ok 'draw-layer) + cr + (install-smoothing cr) + (cairo_set_source_surface cr surface (align-x/delta x 0) (align-y/delta y 0)) + (cairo_paint_with_alpha cr alpha) + (flush-cr))) + (super-new)) dc%) +(define layer-dc-backend<%> + (interface (dc-backend<%>) + get-owner)) + +(define-syntax-rule (define-proxy-methods #:to target method-name ...) + (begin + (define/override (method-name . args) + (send target method-name . args)) + ...)) + +(define layer-mixin + (mixin (dc-backend<%>) (layer-dc-backend<%>) + (init owner) + (define owner-dc owner) + (define/public (get-owner) owner-dc) + + (define-proxy-methods #:to owner-dc + get-pango + collapse-bitmap-b&w? + get-font-metrics-key + dc-adjust-smoothing + dc-adjust-cap-shape + get-hairline-width + install-color + get-size + get-device-scale + get-backing-scale + can-combine-text? + can-mask-bitmap? + get-clear-operator) + + (super-new))) + +(define surface-layer-dc% + (dc-mixin + (class (layer-mixin default-dc-backend%) + (define surface (cairo_recording_surface_create CAIRO_CONTENT_COLOR_ALPHA #f)) + (unless surface + (raise (exn:fail:unsupported + (format (string-append "~a: operation not supported by backend\n" + " backend: cairo\n" + " current version: ~a\n" + " required version: 1.10") + (method-name 'dc<%> 'new-layer) (cairo_version_string))) + (current-continuation-marks))) + + (define cr (cairo_create surface)) + (define/public (get-cairo-surface) surface) + (define/override (get-cr) cr) + + (super-new)))) + (set-text-to-path! (lambda (font str x y combine?) (define s (cairo_recording_surface_create CAIRO_CONTENT_COLOR_ALPHA #f)) diff --git a/draw-lib/racket/draw/private/local.rkt b/draw-lib/racket/draw/private/local.rkt index 54d3b87..872ac5a 100644 --- a/draw-lib/racket/draw/private/local.rkt +++ b/draw-lib/racket/draw/private/local.rkt @@ -27,6 +27,7 @@ get-clipping-matrix reset-config internal-copy + draw-owned-layer ;; region% install-region @@ -59,4 +60,7 @@ can-combine-text? can-mask-bitmap? reset-clip - get-clear-operator) + get-clear-operator + + ;; layer-dc-backend<%> + get-owner) diff --git a/draw-lib/racket/draw/private/page-dc.rkt b/draw-lib/racket/draw/private/page-dc.rkt index c37d180..5d797a9 100644 --- a/draw-lib/racket/draw/private/page-dc.rkt +++ b/draw-lib/racket/draw/private/page-dc.rkt @@ -103,6 +103,7 @@ (draw-rectangle x y w h) (draw-point x y) (draw-line x1 y1 x2 y2) + (draw-layer layer [x [y]]) (clear) (erase)) diff --git a/draw-lib/racket/draw/private/record-dc.rkt b/draw-lib/racket/draw/private/record-dc.rkt index 8eb9090..d93da6b 100644 --- a/draw-lib/racket/draw/private/record-dc.rkt +++ b/draw-lib/racket/draw/private/record-dc.rkt @@ -388,7 +388,7 @@ get-pen get-brush get-font get-smoothing get-text-mode get-background get-text-background get-text-foreground - get-alpha get-clipping-region + get-alpha get-clipping-region get-size translate rotate scale) (define record-limit +inf.0) @@ -457,7 +457,7 @@ (define-syntax (generate-record-unconvert stx) (syntax-case stx () - [(_ ([clause-tags clause-rhs] ...) (defn (name arg ...)) ...) + [(_ record-unconvert ([clause-tags clause-rhs] ...) (defn (name arg ...)) ...) (with-syntax ([((arg-id ...) ...) (let ([names (syntax->list #'(name ...))] [argss (syntax->list #'((arg ...) ...))]) @@ -646,7 +646,22 @@ (install-transform dc (apply-transform state t))) (lambda () `(transform ,t))))) + (define/augride (make-layer) + (define-values (w h) (get-size)) + (new record-layer-dc% [owner this] [width w] [height h])) + + (define/override (draw-owned-layer layer x y) + (define proc (send layer get-recorded-command #f)) + (define datum (send layer get-recorded-command #t)) + (record (lambda (dc state) + (define layer (send dc make-layer)) + (proc layer) + (send dc draw-layer layer x y) + state) + (lambda () `(draw-layer ,datum ,x ,y)))) + (generate-record-unconvert + record-unconvert ([(set-clipping-region) (lambda (r) (define make-r (unconvert-region r)) (lambda (dc state) @@ -682,7 +697,14 @@ (install-transform dc (struct-copy dc-state state [initial-matrix mi]))))] [(transform) (lambda (t) (lambda (dc state) - (install-transform dc (apply-transform state t))))]) + (install-transform dc (apply-transform state t))))] + [(draw-layer) (lambda (datum x y) + (define layer-drawer (generate-drawer (record-unconvert datum))) + (lambda (dc state) + (define layer (send dc make-layer)) + (layer-drawer layer) + (send dc draw-layer layer x y) + state))]) ;; remaining clauses are generated: (define/record (set-smoothing s)) @@ -780,6 +802,8 @@ (super-new) (reset-recording))) +(define record-layer-dc% (record-dc-mixin (dc-mixin (layer-mixin record-dc-backend%)))) + (define (recorded-datum->procedure d) (generate-drawer/restore (send (new record-dc%) record-unconvert d))) diff --git a/draw-lib/racket/draw/unsafe/cairo.rkt b/draw-lib/racket/draw/unsafe/cairo.rkt index f422fbc..c4afb51 100644 --- a/draw-lib/racket/draw/unsafe/cairo.rkt +++ b/draw-lib/racket/draw/unsafe/cairo.rkt @@ -56,6 +56,8 @@ (define-syntax-rule (_cbfun . rest) (_fun #:atomic? #t . rest)) +(define-cairo cairo_version_string (_cfun -> _string)) + (define-cairo cairo_destroy (_cfun _cairo_t -> _void) #:wrap (deallocator))