diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl
index 1964f0e3c7..c04047c7f5 100644
--- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl
+++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-class.scrbl
@@ -10,6 +10,14 @@ A @racket[bitmap%] object is a pixel-based image, either monochrome,
  @racketmodname[racket/gui/base]), @xmethod[canvas% make-bitmap] (from
  @racketmodname[racket/gui/base]), and @secref["Portability"].
 
+A bitmap has a @deftech{backing scale}, which is the number of pixels
+ that correspond to a drawing unit for the bitmap, either when the
+ bitmap is used as a target for drawing or when the bitmap is drawn
+ into another context.  For example, on Mac OS X when the main monitor
+ is in Retina mode, @racket[make-screen-bitmap] returns a bitmap whose
+ backing scale is @racket[2.0]. A monochrome bitmap always has a
+ backing scale of @racket[1.0].
+
 A bitmap is convertible to @racket['png-bytes] through the
 @racketmodname[file/convertible] protocol.
 
@@ -17,7 +25,8 @@ A bitmap is convertible to @racket['png-bytes] through the
 @defconstructor*/make[(([width exact-positive-integer?]
                         [height exact-positive-integer?]
                         [monochrome? any/c #f]
-                        [alpha? any/c #f])
+                        [alpha? any/c #f]
+                        [backing-scale (>/c 0.0) 1.0])
                        ([in (or/c path-string? input-port?)]
                         [kind (or/c 'unknown 'unknown/mask 'unknown/alpha
                                     'gif 'gif/mask 'gif/alpha 
@@ -27,7 +36,8 @@ A bitmap is convertible to @racket['png-bytes] through the
                                     'bmp 'bmp/alpha)
                               'unknown]
                         [bg-color (or/c (is-a?/c color%) #f) #f]
-                        [complain-on-failure? any/c #f])
+                        [complain-on-failure? any/c #f]
+                        [backing-scale (>/c 0.0) 1.0])
                        ([bits bytes?]
                         [width exact-positive-integer?]
                         [height exact-positive-integer?]))]{
@@ -43,12 +53,20 @@ When @racket[width] and @racket[height] are provided: Creates a new
  bitmap. If @racket[monochrome?] is true, the bitmap is monochrome; if
  @racket[monochrome?] is @racket[#f] and @racket[alpha?] is true, the
  bitmap has an alpha channel; otherwise, the bitmap is color without
- an alpha channel. The initial content of the bitmap is ``empty'': all white, and with
+ an alpha channel. The @racket[backing-scale] argument sets the
+ bitmap's @tech{backing scale}, and it must be @racket[1.0] if
+ @racket[monochrome] is true.
+ The initial content of the bitmap is ``empty'': all white, and with
  zero alpha in the case of a bitmap with an alpha channel.
 
 When @racket[in] is provided: Creates a bitmap from a file format,
  where @racket[kind] specifies the format. See @method[bitmap%
- load-file] for details.
+ load-file] for details. The @racket[backing-scale] argument sets the
+ bitmap's @tech{backing scale}, so that the bitmap's size (as reported
+ by @method[bitmap% get-width] and @method[bitmap% get-height]) is the
+ @racket[ceiling] of the bitmap's size from @racket[in] divided by
+ @racket[backing-scale]; the backing scale must be @racket[1.0] if the
+ bitmap is monocrhome or loaded with a mask.
 
 When a @racket[bits] byte string is provided: Creates a monochrome
  bitmap from an array of bit values, where each byte in @racket[bits]
@@ -58,7 +76,6 @@ When a @racket[bits] byte string is provided: Creates a monochrome
  @racket[height] is larger than 8 times the length of @racket[bits],
  @|MismatchExn|.
 
-
 }
 
 @defmethod[(get-argb-pixels [x real?]
@@ -67,25 +84,26 @@ When a @racket[bits] byte string is provided: Creates a monochrome
                             [height exact-nonnegative-integer?]
                             [pixels (and/c bytes? (not/c immutable?))]
                             [just-alpha? any/c #f]
-                            [pre-multiplied? any/c #f])
+                            [pre-multiplied? any/c #f]
+                            [#:unscaled? unscaled? any/c #f])
            void?]{
 
-Produces the same result as @xmethod[bitmap-dc% get-argb-pixels], but the
-bitmap does not have to be selected into the DC (and this method works even if
-the bitmap is selected into another DC, attached as a button label, etc.).
+Produces the same result as @xmethod[bitmap-dc% get-argb-pixels] when
+@racket[unscaled?] is @racket[#f], but the bitmap does not have to be
+selected into the DC (and this method works even if the bitmap is
+selected into another DC, attached as a button label, etc.).
+
+If the bitmap has a @tech{backing scale} other than @racket[1.0] and
+@racket[unscaled?] is true, then the result corresponds to the
+bitmap's pixels ignoring the @tech{backing scale}. In that case,
+@racket[x], @racket[y], @racket[width], and @racket[height] are
+effectively in pixels instead of drawing units.}
 
-}
 
 @defmethod[(get-backing-scale)
            (>/c 0.0)]{
 
-Gets the number of pixels that correspond to a drawing unit for the
-bitmap, either when the bitmap is used as a target for drawing or when
-the bitmap is drawn into another context.
-
-For example, on Mac OS X when the main monitor is in Retina mode,
-@racket[make-screen-bitmap] returns a bitmap whose backing scale is
-@racket[2.0].}
+Returns the bitmap's @tech{backing scale}.}
 
 
 @defmethod[(get-depth)
@@ -109,9 +127,9 @@ image surface.}
 @defmethod[(get-height)
            exact-positive-integer?]{
 
-Gets the height of the bitmap in pixels.
+Gets the height of the bitmap in drawing units (which is the same as
+pixels if the @tech{backing scale} is 1.0).}
 
-}
 
 @defmethod[(get-loaded-mask)
            (or/c (is-a?/c bitmap%) #f)]{
@@ -152,9 +170,9 @@ Unlike an alpha channel, the mask bitmap is @italic{not} used
 @defmethod[(get-width)
            exact-positive-integer?]{
 
-Gets the width of the bitmap in pixels.
+Gets the width of the bitmap in drawing units (which is the same as
+pixels of the @tech{backing scale} is 1.0).}
 
-}
 
 @defmethod[(has-alpha-channel?)
            boolean?]{
@@ -251,7 +269,9 @@ For PNG loading, if @racket[bg-color] is not @racket[#f], then it is
  variable if it is defined. If the preference and environment variable
  are both undefined, a platform-specific default is used.
 
-}
+After a bitmap is created, @method[bitmap% load-file] can be used
+ only if the bitmap's @tech{backing scale} is @racket[1.0].}
+
 
 @defmethod[(make-dc)
            (is-a?/c bitmap-dc%)]{
@@ -271,7 +291,8 @@ Returns @racket[#t] if the bitmap is valid in the sense that an image
 
 @defmethod[(save-file [name (or/c path-string? output-port?)]
                       [kind (or/c 'png 'jpeg 'xbm 'xpm 'bmp)]
-                      [quality (integer-in 0 100) 75])
+                      [quality (integer-in 0 100) 75]
+                      [#:unscaled? unscaled? any/c #f])
            boolean?]{
 
 Writes a bitmap to the named file or output stream.
@@ -307,7 +328,10 @@ A monochrome bitmap saved as @racket['png] without a mask bitmap
  @method[bitmap% load-file], creates a monochrome @racket[bitmap%]
  object.)
 
-}
+If the bitmap has a @tech{backing scale} other than 1.0, then it is
+ effectively converted to a single pixel per drawing unit before
+ saving unless @racket[unscaled?] is true.}
+
 
 @defmethod[(set-argb-pixels [x real?]
                             [y real?]
@@ -315,13 +339,20 @@ A monochrome bitmap saved as @racket['png] without a mask bitmap
                             [height exact-nonnegative-integer?]
                             [pixels bytes?]
                             [just-alpha? any/c #f]
-                            [pre-multiplied? any/c #f])
+                            [pre-multiplied? any/c #f]
+                            [#:unscaled? unscaled? any/c #f])
            void?]{
 
-The same as @xmethod[bitmap-dc% set-argb-pixels], but the
-bitmap does not have to be selected into the DC.
+The same as @xmethod[bitmap-dc% set-argb-pixels] when
+@racket[unscaled?] is @racket[#f], but the bitmap does not have to be
+selected into the DC.
+
+If the bitmap has a @tech{backing scale} other than @racket[1.0] and
+@racket[unscaled?] is true, then pixel values are installed ignoring
+the @tech{backing scale}. In that case, @racket[x], @racket[y],
+@racket[width], and @racket[height] are effectively in pixels instead
+of drawing units.}
 
-}
 
 @defmethod[(set-loaded-mask [mask (is-a?/c bitmap%)])
            void?]{
diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl
index 7e481d6b52..cfa5d063b6 100644
--- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl
+++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/bitmap-dc-class.scrbl
@@ -90,11 +90,10 @@ If @racket[pre-multiplied?] is true, @racket[just-alpha?] is false,
  are scaled by the corresponding alpha value (i.e., multiplied by the
  alpha value and then divided by 255).
 
-If the bitmap has a backing scale (see @xmethod[bitmap%
- get-backing-scale]) other than @racket[1.0], the the result of
- @method[bitmap-dc% get-argb-pixels] is as if the bitmap is drawn to a
- bitmap with a backing scale of @racket[1.0] and the pixels of the
- target bitmap are returned.}
+If the bitmap has a @tech{backing scale} other than @racket[1.0], the
+ result of @method[bitmap-dc% get-argb-pixels] is as if the bitmap is
+ drawn to a bitmap with a backing scale of @racket[1.0] and the pixels
+ of the target bitmap are returned.}
 
 
 @defmethod[(get-bitmap)
@@ -127,7 +126,6 @@ result is @racket[#f].
                             [pre-multiplied? any/c #f])
            void?]{
 
-
 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|).
@@ -158,7 +156,10 @@ If @racket[pre-multiplied?] is true, @racket[just-alpha?] is false,
  is not possible if the value is properly scaled), then it is effectively 
  reduced to the alpha value.
 
-}
+If the bitmap has a @tech{backing scale} other than @racket[1.0], then
+ @racket[pixels] are effectively scaled by the backing scale to obtain
+ pixel values that are installed into the bitmap.}
+
 
 @defmethod[(set-bitmap [bitmap (or/c (is-a?/c bitmap%) #f)])
            void?]{
diff --git a/pkgs/draw-pkgs/draw-doc/scribblings/draw/draw-funcs.scrbl b/pkgs/draw-pkgs/draw-doc/scribblings/draw/draw-funcs.scrbl
index b15d60ffe2..22ab051403 100644
--- a/pkgs/draw-pkgs/draw-doc/scribblings/draw/draw-funcs.scrbl
+++ b/pkgs/draw-pkgs/draw-doc/scribblings/draw/draw-funcs.scrbl
@@ -38,12 +38,13 @@ See @racket[font%] for information about @racket[family].}
 
 @defproc[(make-bitmap [width exact-positive-integer?]
                       [height exact-positive-integer?]
-                      [alpha? any/c #t])
+                      [alpha? any/c #t]
+                      [#:backing-scale backing-scale (>/c 0.0) 1.0])
          (is-a?/c bitmap%)]{
 
-Returns @racket[(make-object bitmap% width height #f alpha?)], but
-this procedure is preferred because it defaults @racket[alpha?] in a
-more useful way.
+Returns @racket[(make-object bitmap% width height #f alpha?
+backing-scale)], but this procedure is preferred because it defaults
+@racket[alpha?] in a more useful way.
 
 See also @racket[make-platform-bitmap] and @secref["Portability"].
 }
@@ -159,7 +160,8 @@ When @racket[stipple] is @racket[#f], @racket[immutable?] is true, and
 
 
 @defproc[(make-platform-bitmap [width exact-positive-integer?]
-                               [height exact-positive-integer?])
+                               [height exact-positive-integer?]
+                               [#:backing-scale backing-scale (>/c 0.0) 1.0])
          (is-a?/c bitmap%)]{
 
 Creates a bitmap that uses platform-specific drawing operations
@@ -176,13 +178,14 @@ on Windows and Mac OS X. See @secref["Portability"] for more information.}
                                   'bmp 'bmp/alpha)
                             'unknown/alpha]
                       [bg-color (or/c (is-a?/c color%) #f) #f]
-                      [complain-on-failure? any/c #t])
+                      [complain-on-failure? any/c #t]
+                      [#:backing-scale backing-scale (>/c 0.0) 1.0])
          (is-a?/c bitmap%)]{
 
 Returns @racket[(make-object bitmap% in kind bg-color
-complain-on-failure?)], but this procedure is preferred because it
-defaults @racket[kind] and @racket[complain-on-failure?] in a more
-useful way.}
+complain-on-failure? backing-scale)], but this procedure is preferred
+because it defaults @racket[kind] and @racket[complain-on-failure?] in
+a more useful way.}
 
 
 @defproc[(recorded-datum->procedure [datum any/c]) ((is-a?/c dc<%>) . -> . void?)]{
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
index dd022c0385..6b1a4e1c39 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
@@ -35,7 +35,7 @@
 ;; FIXME: there must be some way to abstract over all many of the
 ;; ARGB/RGBA/BGRA iterations.
 
-(define-struct alternate-bitmap-kind (width height))
+(define-struct alternate-bitmap-kind (width height scale))
 
 (define-local-member-name
   get-alphas-as-mask
@@ -141,6 +141,9 @@
 (define (get-empty-surface)
   (cairo_image_surface_create CAIRO_FORMAT_ARGB32 1 1))
 
+(define (*i x y) (inexact->exact (ceiling (* x y))))
+(define (/i x y) (inexact->exact (ceiling (/ x y))))
+
 (define bitmap%
   (class* object% (png-convertible<%>)
 
@@ -162,25 +165,29 @@
     (init-rest args)
     (super-new)
 
-    (define-values (alt? width height b&w? alpha-channel? s loaded-mask)
+    (define-values (alt? width height b&w? alpha-channel? s loaded-mask backing-scale)
       (case-args
        args
        [([alternate-bitmap-kind? a])
         (values #t
                 (alternate-bitmap-kind-width a)
                 (alternate-bitmap-kind-height a)
-                #f #t #f #f)]
+                #f #t #f #f
+                (alternate-bitmap-kind-scale a))]
        [([exact-positive-integer? w]
          [exact-positive-integer? h]
          [any? [b&w? #f]]
-         [any? [alpha? #f]])
+         [any? [alpha? #f]]
+         [positive-real? [scale 1.0]])
         (values
          #f
          w
          h
          (and b&w? #t)
          (and alpha? (not b&w?))
-         (let ([s (cairo_image_surface_create CAIRO_FORMAT_ARGB32 (max w 1) (max h 1))])
+         (let ([s (cairo_image_surface_create CAIRO_FORMAT_ARGB32
+                                              (max (*i scale w) 1)
+                                              (max (*i scale h) 1))])
            (cairo_surface_flush s)
            (cond
             [b&w?
@@ -194,11 +201,13 @@
              (bytes-fill! (cairo_image_surface_get_data s) 255)])
            (cairo_surface_mark_dirty s)
            s)
-         #f)]
+         #f
+         (* 1.0 scale))]
        [([(make-alts path-string? input-port?) filename]
          [bitmap-file-kind-symbol? [kind 'unknown]]
          [(make-or-false color%) [bg-color #f]]
-         [any? [complain-on-failure? #f]])
+         [any? [complain-on-failure? #f]]
+         [positive-real? [scale 1.0]])
         (let-values ([(s b&w?) (do-load-bitmap filename kind bg-color complain-on-failure?)]
                      [(alpha?) (memq kind '(unknown/alpha gif/alpha jpeg/alpha
                                                           png/alpha xbm/alpha xpm/alpha
@@ -230,13 +239,14 @@
                          (cairo_surface_mark_dirty s))))])
             (if s
                 (values #f
-                        (cairo_image_surface_get_width s)
-                        (cairo_image_surface_get_height s)
+                        (/i (cairo_image_surface_get_width s) scale)
+                        (/i (cairo_image_surface_get_height s) scale)
                         b&w?
                         (and alpha? (not b&w?))
                         s
-                        mask-bm)
-                (values #f 0 0 #f #f #f #f))))]
+                        mask-bm
+                        (* 1.0 scale))
+                (values #f 0 0 #f #f #f #f (* 1.0 scale)))))]
        [([bytes? bstr]
          [exact-positive-integer? w]
          [exact-positive-integer? h])
@@ -251,9 +261,20 @@
                            (let ([s (* i bw)])
                              (subbytes bstr s (+ s bw)))))])
               (install-bytes-rows s w h rows #t #f #f #t))
-            (values #f w h #t #f s #f)))]
+            (values #f w h #t #f s #f 1.0)))]
        (init-name 'bitmap%)))
 
+    (when (not (= backing-scale 1.0))
+      (when (or b&w? loaded-mask)
+        (error (init-name 'bitmap%)
+               (string-append
+                "~a must have a backing scale of 1.0\n"
+                "  given scale: ~a")
+               (if b&w?
+                   "black-and-white bitmap"
+                   "bitmap with mask")
+               backing-scale)))
+
     ;; Use for non-alpha color bitmaps when they are used as a mask:
     (define alpha-s #f)
     (define alpha-s-up-to-date? #f)
@@ -281,7 +302,14 @@
                               this)))
 
     (def/public (get-loaded-mask) loaded-mask)
-    (def/public (set-loaded-mask [(make-or-false bitmap%) m]) (set! loaded-mask m))
+    (def/public (set-loaded-mask [(make-or-false bitmap%) m])
+      (unless (= backing-scale 1)
+        (error (method-name 'bitmap% 'set-loaded-mask)
+               (string-append
+                "can only install a mask for a bitmap with backing scale of 1.0\n"
+                "  backing scale: ~a")
+               backing-scale))
+      (set! loaded-mask m))
 
     (define/public (draw-bitmap-to cr sx sy dx dy w h alpha clipping)
       #f)
@@ -304,6 +332,12 @@
                               [bg #f]
                               [complain-on-failure? #f])
       (check-alternate 'load-file)
+      (unless (= 1 backing-scale)
+        (error (method-name 'bitmap% 'load-file)
+               (string-append
+                "can only load a file in a bitmap with backing scale of 1.0\n"
+                "  backing scale: ~a")
+               backing-scale))
       (release-bitmap-storage)
       (set!-values (s b&w?) (do-load-bitmap in kind bg complain-on-failure?))
       (set! width (if s (cairo_image_surface_get_width s) 0))
@@ -501,19 +535,18 @@
                       (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)
+    (define/private (call-with-alt-bitmap x y w h sc 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))
-          (let ([sc (get-cairo-device-scale)])
-            (unless (= sc 1)
-              (let ([m (make-cairo_matrix_t 0.0 0.0 0.0 0.0 0.0 0.0)])
-                (cairo_matrix_init_translate m 0 0)
-                (cairo_matrix_scale m sc sc)
-                (cairo_matrix_translate m x y)
-                (cairo_pattern_set_matrix (cairo_get_source cr) m))))
+          (unless (= sc 1)
+            (let ([m (make-cairo_matrix_t 0.0 0.0 0.0 0.0 0.0 0.0)])
+              (cairo_matrix_init_translate m 0 0)
+              (cairo_matrix_scale m sc sc)
+              (cairo_matrix_translate m x y)
+              (cairo_pattern_set_matrix (cairo_get_source cr) m)))
           (cairo_new_path cr)
           (cairo_rectangle cr 0 0 w h)
           (cairo_fill cr)
@@ -523,12 +556,15 @@
         (proc bm)
         (send bm release-bitmap-storage)))
 
-    (define/public (save-file out [kind 'unknown] [quality 75])
+    (define/public (save-file out [kind 'unknown] [quality 75]
+                              #:unscaled? [unscaled? #f])
       (and (ok?)
            (begin
-             (if alt?
+             (if (or alt?
+                     (and (not unscaled?)
+                          (not (= backing-scale 1))))
                  (call-with-alt-bitmap
-                  0 0 width height
+                  0 0 width height (if unscaled? 1 backing-scale)
                   (lambda (bm)
                     (send bm save-file out kind quality)))
                  (do-save-file out kind quality))
@@ -570,8 +606,10 @@
                            loaded-mask
                            (= width (send loaded-mask get-width))
                            (= height (send loaded-mask get-height)))
-               (let ([bstr (make-bytes (* width height 4))])
-                 (get-argb-pixels 0 0 width height bstr)
+               (let* ([width (*i width backing-scale)]
+                      [height (*i height backing-scale)]
+                      [bstr (make-bytes (* width height 4))])
+                 (get-argb-pixels 0 0 width height bstr #:unscaled? #t)
                  (when loaded-mask
                    (send loaded-mask get-argb-pixels 0 0 width height bstr #t))
                  ;; PNG wants RGBA instead of ARGB...
@@ -599,7 +637,9 @@
                   proc
                   (cairo_surface_write_to_png_stream s proc)))])]
             [(jpeg)
-             (let ([c (create-compress out)])
+             (let ([c (create-compress out)]
+                   [width (*i width backing-scale)]
+                   [height (*i height backing-scale)])
                (dynamic-wind
                    void
                    (lambda ()
@@ -644,7 +684,7 @@
                 alpha-s))
           (get-empty-surface)))
 
-    (define/public (get-cairo-device-scale) 1.0)
+    (define/public (get-cairo-device-scale) backing-scale)
 
     (define/public (get-backing-scale) (get-cairo-device-scale))
 
@@ -652,19 +692,24 @@
 
     (define/public (get-argb-pixels x y w h bstr
                                     [get-alpha? #f]
-                                    [pre-mult? #f])
+                                    [pre-mult? #f]
+                                    #:unscaled? [unscaled? #f])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'get-argb-pixels)
                               "byte string is too short: "
                               bstr))
       (when (ok?)
-        (if alt?
-            (call-with-alt-bitmap
-             x y w h
-             (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha? pre-mult?)))
-            (do-get-argb-pixels x y w h bstr get-alpha? pre-mult?))))
+        (unless (or (zero? w) (zero? h))
+          (if (or alt?
+                  (and (not unscaled?)
+                       (not (= backing-scale 1))))
+              (call-with-alt-bitmap
+               x y w h (if unscaled? 1 backing-scale)
+               (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha? pre-mult?)))
+              (do-get-argb-pixels x y w h bstr get-alpha? pre-mult?
+                                  (*i width backing-scale) (*i height backing-scale))))))
 
-    (define/private (do-get-argb-pixels x y w h bstr get-alpha? pre-mult?)
+    (define/private (do-get-argb-pixels x y w h bstr get-alpha? pre-mult? width height)
       ;; Fill range that is beyond edge of picture:
       (if get-alpha?
           (for* ([i (in-range width (+ x w))]
@@ -724,15 +769,40 @@
 
     (define/public (set-argb-pixels x y w h bstr
                                     [set-alpha? #f]
-                                    [pre-mult? #f])
+                                    [pre-mult? #f]
+                                    #:unscaled? [unscaled? #f])
       (unless ((bytes-length bstr) . >=  . (* w h 4))
         (raise-mismatch-error (method-name 'bitmap% 'set-argb-pixels)
                               "byte string is too short: "
                               bstr))
       (check-alternate 'set-argb-pixels)
-      (when (ok?)
+      (cond
+       [(and (not unscaled?)
+             (not (= backing-scale 1)))
+        ;; scale input to match backing:
+        (define s backing-scale)
+        (define kw (max (*i 1 s) 1))
+        (define sw (+ kw (*i (sub1 w) s)))
+        (define sh (+ kw (*i (sub1 h) s)))
+        (define bstr2 (make-bytes (* sw sh 4)))
+        (for ([j (in-range h)])
+          (define sj (*i j s))
+          (for ([i (in-range w)])
+            (define si (*i i s))
+            (define p (+ (* j 4 w) (* i 4)))
+            (for* ([ik (in-range kw)]
+                   [jk (in-range kw)])
+              (define p2 (+ (* (+ sj jk) 4 sw) (* (+ si ik) 4)))
+              (bytes-set! bstr2 p2 (bytes-ref bstr p))
+              (bytes-set! bstr2 (+ p2 1) (bytes-ref bstr (+ p 1)))
+              (bytes-set! bstr2 (+ p2 2) (bytes-ref bstr (+ p 2)))
+              (bytes-set! bstr2 (+ p2 3) (bytes-ref bstr (+ p 3))))))
+        (set-argb-pixels (*i x s) (*i y s) sw sh bstr2 set-alpha? pre-mult? #:unscaled? 1)]
+       [(ok?)
         ;; Set pixels:
-        (let-values ([(A R G B) (argb-indices)])
+        (let-values ([(A R G B) (argb-indices)]
+                     [(width) (if unscaled? (*i width backing-scale) width)]
+                     [(height) (if unscaled? (*i height backing-scale) height)])
           (when (not set-alpha?)
             (cairo_surface_flush s)
             (let ([data (cairo_image_surface_get_data s)]
@@ -793,7 +863,7 @@
                (not alpha-channel?))
           ;; Set alphas:
           (set-alphas-as-mask x y w h bstr (* 4 w) 0)])
-        (drop-alpha-s)))
+        (drop-alpha-s)]))
 
     (define/public (get-alphas-as-mask x y w h bstr)
       (let ([data (cairo_image_surface_get_data (if (or b&w? alpha-channel?)
@@ -869,20 +939,20 @@
                     (bytes-set! data (+ q 1) vv)
                     (bytes-set! data (+ q 2) vv)
                     (bytes-set! data (+ q A) (if b&w? v 255)))))))
-          (cairo_surface_mark_dirty s))))
-
-    ))
+          (cairo_surface_mark_dirty s))))))
 
 (define/top (make-bitmap [exact-positive-integer? w]
                          [exact-positive-integer? h]
-                         [any? [alpha? #t]])
-  (make-object bitmap% w h #f alpha?))
+                         [any? [alpha? #t]]
+                         #:backing-scale [nonnegative-real? [backing-scale 1.0]])
+  (make-object bitmap% w h #f alpha? backing-scale))
 
 (define/top (read-bitmap [(make-alts path-string? input-port?) filename]
                          [bitmap-file-kind-symbol? [kind 'unknown/alpha]]
                          [(make-or-false color%) [bg-color #f]]
-                         [any? [complain-on-failure? #t]])
-  (make-object bitmap% filename kind bg-color complain-on-failure?))
+                         [any? [complain-on-failure? #t]]
+                         #:backing-scale [nonnegative-real? [backing-scale 1.0]])
+  (make-object bitmap% filename kind bg-color complain-on-failure? backing-scale))
 
 (define/top (make-monochrome-bitmap [exact-positive-integer? w]
                                     [exact-positive-integer? h]
@@ -892,17 +962,18 @@
       (make-object bitmap% w h #t)))
 
 (define/top (make-platform-bitmap [exact-positive-integer? w]
-                                  [exact-positive-integer? h])
+                                  [exact-positive-integer? h]
+                                  #:backing-scale [nonnegative-real? [backing-scale 1.0]])
   (case (system-type)
-    [(macosx) (make-object quartz-bitmap% w h)]
-    [(windows) (make-object win32-no-hwnd-bitmap% w h)]
-    [(unix) (make-bitmap w h)]))
+    [(macosx) (make-object quartz-bitmap% w h #t backing-scale)]
+    [(windows) (make-object win32-no-hwnd-bitmap% w h backing-scale)]
+    [(unix) (make-bitmap w h #:backing-scale backing-scale)]))
 
 (define-local-member-name build-cairo-surface)
 (define win32-no-hwnd-bitmap%
   (class bitmap%
-    (init w h)
-    (super-make-object (make-alternate-bitmap-kind w h))
+    (init w h backing-scale)
+    (super-make-object (make-alternate-bitmap-kind w h backing-scale))
 
     (define s (build-cairo-surface w h))
     ;; erase the bitmap
@@ -928,20 +999,11 @@
 (define quartz-bitmap%
   (class bitmap%
     (init w h [with-alpha? #t] [resolution 1.0] [dest-cg #f])
-    (super-make-object (make-alternate-bitmap-kind w h))
-    
-    (define cocoa-resolution resolution)
-    
-    (define/override (get-cairo-device-scale)
-      cocoa-resolution)
+    (super-make-object (make-alternate-bitmap-kind w h resolution))
     
     (define s
-      (let* ([sw (inexact->exact
-                  (ceiling
-                   (* cocoa-resolution w)))]
-             [sh (inexact->exact
-                  (ceiling
-                   (* cocoa-resolution h)))]
+      (let* ([sw (*i resolution w)]
+             [sh (*i resolution h)]
              [s (if dest-cg
                     (cairo_quartz_surface_create_for_cg_context dest-cg sw sh)
                     (cairo_quartz_surface_create (if with-alpha?
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/contract.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/contract.rkt
index a6936c4f36..9d09fb422e 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/contract.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/contract.rkt
@@ -403,7 +403,7 @@
                         exact-nonnegative-integer?
                         exact-nonnegative-integer?
                         (and/c bytes? (not/c immutable?)))
-                       (any/c any/c)
+                       (any/c any/c #:unscaled? any/c)
                        void?))
     (get-depth (->m exact-nonnegative-integer?))
     (get-height (->m exact-nonnegative-integer?))
@@ -424,7 +424,8 @@
     (ok? (->m boolean?))
     (save-file (->*m ((or/c path-string? output-port?)
                       (or/c 'png 'jpeg 'xbm 'xpm 'bmp))
-                     ((integer-in 0 100))
+                     ((integer-in 0 100)
+                      #:unscaled? any/c)
                      boolean?))
     (set-argb-pixels (->*m
                        (exact-nonnegative-integer?
@@ -432,6 +433,6 @@
                         exact-nonnegative-integer?
                         exact-nonnegative-integer?
                         bytes?)
-                       (any/c any/c)
+                       (any/c any/c #:unscaled? any/c)
                        void?))
     (set-loaded-mask (->m (is-a?/c bitmap%) void?))))
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/record-dc.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/record-dc.rkt
index 3221940cb5..4199e18de4 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/record-dc.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/record-dc.rkt
@@ -292,7 +292,8 @@
                                   (send b get-width) 
                                   (send b get-height)
                                   (not (send b is-color?))
-                                  (send b has-alpha-channel?))]
+                                  (send b has-alpha-channel?)
+                                  (send b get-backing-scale))]
               [dc (make-object bitmap-dc% new-b)])
          (send dc draw-bitmap b 0 0)
          (send dc set-bitmap #f)
@@ -303,20 +304,30 @@
        (let ()
          (define w (send b get-width))
          (define h (send b get-height))
-         (define bstr (make-bytes (* 4 w h)))
-         (send b get-argb-pixels 0 0 w h bstr)
-         (list w h 
-               (send b is-color?)
-               (send b has-alpha-channel?)
-               (bytes->immutable-bytes bstr)))))
+         (define s (send b get-backing-scale))
+         (define (scale v) (inexact->exact (ceiling (* s v))))
+         (define sw (scale w))
+         (define sh (scale h))
+         (define bstr (make-bytes (* 4 sw sh)))
+         (send b get-argb-pixels 0 0 sw sh bstr #:unscaled? #t)
+         (define l (list w h
+                         (send b is-color?)
+                         (send b has-alpha-channel?)
+                         (bytes->immutable-bytes bstr)))
+         (if (= s 1)
+             l
+             (list* 'scale s l)))))
 
 (define (unconvert-bitmap l)
   (and l
        (let ()
-         (define-values (w h color? alpha? bstr)
-           (apply values l))
-         (define bm (make-object bitmap% w h (not color?) alpha?))
-         (send bm set-argb-pixels 0 0 w h bstr)
+         (define-values (s w h color? alpha? bstr)
+           (apply values (if (eq? (car l) 'scale)
+                             (cdr l)
+                             (cons 1.0 l))))
+         (define bm (make-object bitmap% w h (not color?) alpha? #:backing-scale s))
+         (define (scale v) (inexact->exact (ceiling (* s v))))
+         (send bm set-argb-pixels 0 0 (scale w) (scale h) bstr #:unscaled? #t)
          bm)))
 
 (define (convert-font f)
diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/syntax.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/syntax.rkt
index 703dc0750c..90bb3857ad 100644
--- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/syntax.rkt
+++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/syntax.rkt
@@ -6,7 +6,7 @@
 (provide defclass defclass*
          def/public def/pubment def/public-final def/override def/override-final define/top case-args
          def/public-unimplemented define-unimplemented
-         maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts 
+         maybe-box? any? bool? nonnegative-real? positive-real? make-or-false make-box make-list make-alts 
          make-literal symbol-in integer-in real-in make-procedure
          method-name init-name
          let-boxes
@@ -125,7 +125,9 @@
   (if (apply-pred pred val)
       #f
       (cons (predicate-name pred)
-            pos)))
+            (if (keyword? pos)
+                (list val)
+                pos))))
 
 (define (predicate-name pred)
   (cond
@@ -141,6 +143,7 @@
 (define (any? v) #t)
 (define (bool? v) #t)
 (define (nonnegative-real? v) (and (real? v) (v . >= . 0)))
+(define (positive-real? v) (and (real? v) (v . > . 0)))
 
 (define (method-of cls nam)
   (if cls
@@ -149,21 +152,51 @@
 
 (define-syntax (def/thing stx)
   (syntax-case stx ()
-    [(_ define/orig (_ (id [arg-type arg] ...)))
+    [(_ define/orig (_ (id arg ...)))
      (raise-syntax-error #f "missing body" stx)]
-    [(_ define/orig (_ (id [arg-type arg] ...) . body))
-     (with-syntax ([(_ _ orig-stx) stx]
-                   [(pos ...) (for/list ([i (in-range (length (syntax->list #'(arg ...))))])
-                                i)]
-                   [cname (syntax-parameter-value #'class-name)])
-       (syntax/loc #'orig-stx
-         (define/orig (id arg ...)
-           (let ([bad (or (check-arg (just-id arg) arg-type pos)
-                          ...)])
-             (when bad
-               (raise-type-error (method-of 'cname 'id) (car bad) (cdr bad) (just-id arg) ...)))
-           (let ()
-             . body))))]))
+    [(_ define/orig (_ (id orig-arg ...) . body))
+     (let ([extract (lambda (keep-kw? mode)
+                      (let loop ([args (syntax->list #'(orig-arg ...))]
+                                 [pos 0]
+                                 [prev-kw #f])
+                        (cond
+                         [(null? args) null]
+                         [(keyword? (syntax-e (car args)))
+                          (if keep-kw?
+                              (cons (car args) (loop (cdr args) pos (car args)))
+                              (loop (cdr args) pos (car args)))]
+                         [else (cons (syntax-case (car args) ()
+                                       [[arg-type arg] (case mode
+                                                         [(type) #'arg-type]
+                                                         [(arg) #'arg]
+                                                         [(id) (syntax-case #'arg ()
+                                                                 [[id val] #'id]
+                                                                 [_ #'arg])]
+                                                         [(pos) (or prev-kw pos)])])
+                                     (loop (cdr args) (if prev-kw pos (add1 pos)) #f))])))])
+       (with-syntax ([(arg-id ...) (extract #f 'id)]
+                     [(arg-rep ...) (extract #t 'id)]
+                     [(arg ...) (extract #t 'arg)]
+                     [(arg-type ...) (extract #f 'type)]
+                     [(pos ...) (extract #f 'pos)])
+         (with-syntax ([(_ _ orig-stx) stx]
+                       [cname (syntax-parameter-value #'class-name)])
+           (syntax/loc #'orig-stx
+             (define/orig (id arg ...)
+               (let ([bad (or (check-arg arg-id arg-type 'pos)
+                              ...)])
+                 (when bad
+                   (type-error (method-of 'cname 'id) (car bad) (cdr bad) arg-rep ...)))
+               (let ()
+                 . body))))))]))
+
+(define type-error
+  (make-keyword-procedure
+   (lambda (kws kw-args name expected pos . args)
+     (if (number? pos)
+         (raise-type-error name expected pos args)
+         (raise-type-error name expected (car pos))))))
+     
 
 (define-for-syntax lifted (make-hash))
 (define-syntax (lift-predicate stx)
diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt
index c57cc460c1..6b42b5be75 100644
--- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt
+++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/gtk/dc.rkt
@@ -45,7 +45,7 @@
 (define x11-bitmap%
   (class bitmap%
     (init w h gdk-win)
-    (super-make-object (make-alternate-bitmap-kind w h))
+    (super-make-object (make-alternate-bitmap-kind w h 1.0))
 
     (define pixmap (gdk_pixmap_new gdk-win 
 				   (min (max 1 w) 32000)
diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
index af95da3fe3..a7459986df 100644
--- a/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
+++ b/pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
@@ -751,6 +751,66 @@
 
 (test #t 'get-path-bounding-box (test-square-bounding-boxes))
 
+;; -----------------------------------------------------------
+;; Check pixel operations on a bitmap with a x2 backing scale
+
+(let ([bm (make-bitmap 10 11 #:backing-scale 2)])
+  (test 2.0 'scale (send bm get-backing-scale))
+  (test 10 'width (send bm get-width))
+  (test 11 'height (send bm get-height))
+
+  (define dc (send bm make-dc))
+  (send dc set-pen "black" 0 'transparent)
+  (send dc set-brush (make-color 100 100 200) 'solid)
+  (send dc draw-rectangle 0 0 3 3)
+
+  (let ([s (make-bytes 4)])
+    (send bm get-argb-pixels 2 2 1 1 s)
+    (test (list 255 100 100 200) 'scaled (bytes->list s))
+    (send bm get-argb-pixels 4 4 1 1 s)
+    (test 0 'scaled (bytes-ref s 0))
+    (send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t)
+    (test (list 255 100 100 200) 'unscaled (bytes->list s))
+
+    (send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0" 
+          #:unscaled? #t)
+    (send bm get-argb-pixels 0 0 1 1 s #:unscaled? #t)
+    (test (list 255 0 0 0) 'unscaled (bytes->list s))
+    ;; scaled is average of black and blue:
+    (send bm get-argb-pixels 0 0 1 1 s)
+    (test (list 255 50 50 100) 'scaled (bytes->list s))
+
+    (send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0")
+    (send bm get-argb-pixels 0 0 1 1 s)
+    (test (list 255 0 0 0) 'scaled (bytes->list s))))
+
+(let ([p (collection-file-path "sk.jpg" "icons")])
+  (let ([bm1 (read-bitmap p)]
+        [bm2 (read-bitmap p #:backing-scale 2)])
+    (test 2.0 'scale (send bm2 get-backing-scale))
+    (test (ceiling (* 1/2 (send bm1 get-width))) 'read-width (send bm2 get-width))
+    (test (ceiling (* 1/2 (send bm1 get-height))) 'read-height (send bm2 get-height))))
+
+(let ([p (collection-file-path "very-small-planet.png" "icons")])
+  (define-syntax-rule (test-fail rx body)
+    (test #t 
+          'error
+          (with-handlers ([exn? (lambda (e)
+                                  (regexp-match? rx (exn-message e)))])
+            body
+            #f)))
+  (test-fail "mask.*backing scale" (read-bitmap p 
+                                                'png/mask
+                                                #:backing-scale 2))
+  (test-fail "can only install a mask.*backing scale"
+             (send (read-bitmap p #:backing-scale 2)
+                   set-loaded-mask
+                   (read-bitmap p)))
+  (test-fail "can only load a file.*backing scale"
+             (send (read-bitmap p #:backing-scale 2)
+                   load-file
+                   p)))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
index 135e429dac..880c35b345 100644
--- a/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
+++ b/pkgs/gui-pkgs/gui-test/tests/gracket/draw.rkt
@@ -225,6 +225,7 @@
        [use-bitmap? #f]
        [platform-bitmap? #f]
        [compat-bitmap? #f]
+       [scaled-bitmap? #f]
        [use-record? #f]
        [serialize-record? #f]
        [use-bad? #f]
@@ -309,6 +310,8 @@
                                        (make-platform-bitmap w h)]
                                       [compat-bitmap?
                                        (send this make-bitmap w h)]
+                                      [scaled-bitmap?
+                                       (make-bitmap w h #:backing-scale 3.0)]
                                       [else
                                        (make-object bitmap% w h depth-one? c-gray?)])))
 			       #f)]
@@ -1310,15 +1313,16 @@
 	    (super-new [parent parent][style '(hscroll vscroll)])
 	    (init-auto-scrollbars (* 2 DRAW-WIDTH) (* 2 DRAW-HEIGHT) 0 0))
 	  vp)])
-    (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Record" "Serialize" "Bad") hp0
+    (make-object choice% #f '("Canvas" "Pixmap" "Bitmap" "Platform" "Compatible" "Backing x3" "Record" "Serialize" "Bad") hp0
 		 (lambda (self event)
 		   (set! use-bitmap? (< 0 (send self get-selection)))
 		   (set! depth-one? (= 2 (send self get-selection)))
 		   (set! platform-bitmap? (= 3 (send self get-selection)))
 		   (set! compat-bitmap? (= 4 (send self get-selection)))
-		   (set! use-record? (<= 5 (send self get-selection) 6))
-		   (set! serialize-record? (= 6 (send self get-selection)))
-		   (set! use-bad? (< 7 (send self get-selection)))
+		   (set! scaled-bitmap? (= 5 (send self get-selection)))
+		   (set! use-record? (<= 6 (send self get-selection) 6))
+		   (set! serialize-record? (= 7 (send self get-selection)))
+		   (set! use-bad? (< 8 (send self get-selection)))
 		   (send canvas refresh)))
     (make-object button% "PS" hp
 		 (lambda (self event)