fix save-file and get-argb-pixels for screen bitmaps

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)

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))]

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 

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.
 

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))