diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index 72e77eaa59..aaa1bc4dbe 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -26,9 +26,17 @@ (super-make-object (make-alternate-bitmap-kind w h)) (define s - (cairo_quartz_surface_create CAIRO_FORMAT_ARGB32 - w - h)) + (let ([s (cairo_quartz_surface_create CAIRO_FORMAT_ARGB32 + w + h)]) + ;; initialize bitmap to empty - needed? + #; + (let ([cr (cairo_create s)]) + (cairo_set_operator cr CAIRO_OPERATOR_CLEAR) + (cairo_set_source_rgba cr 1.0 1.0 1.0 1.0) + (cairo_paint cr) + (cairo_destroy cr)) + s)) (define/override (ok?) #t) (define/override (is-color?) #t) diff --git a/collects/racket/draw/bitmap.rkt b/collects/racket/draw/bitmap.rkt index c1e29dddc0..00092a8e5b 100644 --- a/collects/racket/draw/bitmap.rkt +++ b/collects/racket/draw/bitmap.rkt @@ -210,7 +210,7 @@ #f) (define/private (check-ok who) - (unless s + (unless (ok?) (error (method-name 'bitmap% who) "bitmap is not ok"))) (define locked 0) @@ -409,12 +409,31 @@ (unsafe-bytes-set! dest (fx+ pos B) (premult al (unsafe-bytes-ref r (fx+ spos 2)))))))))) (cairo_surface_mark_dirty s))) + (define/private (call-with-alt-bitmap x y w h proc) + (let* ([bm (make-object bitmap% w h #f #t)] + [cr (cairo_create (send bm get-cairo-surface))]) + (let ([p (cairo_get_source cr)]) + (cairo_pattern_reference p) + (cairo_set_source_surface cr (get-cairo-surface) (- x) (- y)) + (cairo_new_path cr) + (cairo_rectangle cr 0 0 w h) + (cairo_fill cr) + (cairo_set_source cr p) + (cairo_pattern_destroy p)) + (cairo_destroy cr) + (proc bm) + (send bm release-bitmap-storage))) + (def/public (save-file [(make-alts path-string? output-port?) out] [save-kind-symbol? [kind 'unknown]] [quality-integer? [quality 75]]) - (check-alternate 'save-file) (check-ok 'save-file) - (do-save-file out kind quality)) + (if alt? + (call-with-alt-bitmap + 0 0 width height + (lambda (bm) + (send bm save-file out kind quality))) + (do-save-file out kind quality))) (define/private (do-save-file out kind quality) (if (path-string? out) @@ -534,7 +553,13 @@ (raise-mismatch-error (method-name 'bitmap% 'get-argb-pixels) "byte string is too short: " bstr)) - (check-alternate 'get-argb-pixels) + (if alt? + (call-with-alt-bitmap + x y w h + (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha?))) + (do-get-argb-pixels x y w h bstr get-alpha?))) + + (define/private (do-get-argb-pixels x y w h bstr get-alpha?) ;; Fill range that is beyond edge of picture: (if get-alpha? (for* ([i (in-range width (+ x w))] diff --git a/collects/scribblings/gui/bitmap-class.scrbl b/collects/scribblings/gui/bitmap-class.scrbl index 81b91618c9..408224977f 100644 --- a/collects/scribblings/gui/bitmap-class.scrbl +++ b/collects/scribblings/gui/bitmap-class.scrbl @@ -154,7 +154,9 @@ Returns @scheme[#f] if the bitmap is monochrome, @scheme[#t] otherwise. [bg-color (or/c (is-a?/c color%) false/c) #f]) boolean?]{ -Loads a bitmap from a file format that read from @racket[in]. +Loads a bitmap from a file format that read from @racket[in], unless + the bitmap was produced by @racket[make-screen-bitmap] or + @xmethod[canvas% make-bitmap] (in which case @|MismatchExn|). If the bitmap is in use by a @scheme[bitmap-dc%] object or a control, the image data is not loaded. The bitmap changes its size and depth to match that of diff --git a/collects/scribblings/gui/bitmap-dc-class.scrbl b/collects/scribblings/gui/bitmap-dc-class.scrbl index 58a50f3ec3..5d47418f1b 100644 --- a/collects/scribblings/gui/bitmap-dc-class.scrbl +++ b/collects/scribblings/gui/bitmap-dc-class.scrbl @@ -98,12 +98,6 @@ Fills @scheme[color] with the color of the current pixel at position successfully obtained, the return value is @scheme[#t], otherwise the result is @scheme[#f]. -Under X, interleaving drawing commands with @method[bitmap-dc% -get-pixel] calls (for the same @scheme[bitmap-dc%] object) incurs a -substantial performance penalty, except for interleaved calls to -@method[bitmap-dc% set-pixel], @method[bitmap-dc% set-argb-pixels], -and @method[bitmap-dc% get-argb-pixels]. - } @defmethod[(set-argb-pixels [x real?] @@ -115,10 +109,9 @@ and @method[bitmap-dc% get-argb-pixels]. void?]{ -Sets a rectangle of pixels in the bitmap, subject to the same - rules and performance characteristics of -@method[bitmap-dc% set-pixel], except that the block set is likely to be faster than the - sequence of individual sets. +Sets a rectangle of pixels in the bitmap, unless + the DC's current bitmap was produced by @racket[make-screen-bitmap] or + @xmethod[canvas% make-bitmap] (in which case @|MismatchExn|). The pixel RGB values are taken from @scheme[pixels]. The first byte represents an alpha value, the second byte represents a red value to @@ -129,10 +122,11 @@ The pixel RGB values are taken from @scheme[pixels]. The first byte order, left to right then top to bottom. If @scheme[alpha?] is false, then the alpha value for each pixel is - ignored. If @scheme[alpha?] is true, then each + used only if the DC's current bitmap has an alpha channel. If @scheme[alpha?] is true, then each pixel is set based @italic{only} on the alpha value, but inverted to serve - as a mask. Thus, the same - @scheme[pixels] byte string is in general used with two bitmaps, one + as a mask. Thus, when working with bitmaps that have an associated mask + bitmap instead of an alpha channel, the same + @scheme[pixels] byte string is used with two bitmaps: one (the main image) for the pixel values and one (the mask) for the alpha values. diff --git a/collects/scribblings/gui/blurbs.rkt b/collects/scribblings/gui/blurbs.rkt index bd23f1dbbc..425a7eef50 100644 --- a/collects/scribblings/gui/blurbs.rkt +++ b/collects/scribblings/gui/blurbs.rkt @@ -4,7 +4,8 @@ scribble/manual scribble/scheme scribble/decode - (for-label scheme/gui/base) + (for-label scheme/gui/base + scheme/base) (for-syntax scheme/base)) (provide (except-out (all-defined-out) p define-inline))