From dd997cb2dc0779be23ff6cefb91d8d031750add3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 22 Jan 2014 20:03:24 -0700
Subject: [PATCH] racket/gui win32: fix handling of @2x bitmaps

Closes PR 14310

original commit: 8a9a592c3ccc508f8547db5db918d008a611d385
---
 .../gui-lib/mred/private/wx/win32/hbitmap.rkt |  6 +++++
 pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt | 23 ++++++++++++++++++-
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt
index f4b2569a..ecb9b015 100644
--- a/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt
+++ b/pkgs/gui-pkgs/gui-lib/mred/private/wx/win32/hbitmap.rkt
@@ -56,6 +56,12 @@
         (let ([p (cairo_get_source cr)])
           (cairo_pattern_reference p)
           (cairo_set_source_surface cr (send bm get-cairo-surface) 0 0)
+          (let ([sc (send bm 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_pattern_set_matrix (cairo_get_source cr) m))))
           (if mask-p
               (cairo_mask cr mask-p)
               (begin
diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt
index 99164261..c5af4fc4 100644
--- a/pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt
+++ b/pkgs/gui-pkgs/gui-test/tests/gracket/item.rkt
@@ -359,11 +359,13 @@
 (define return-bmp 
   (make-object bitmap2% (icons-path "return.xbm") 'xbm))
 (define bb-bmp
-  (make-object bitmap2% (icons-path "bb.gif") 'gif))
+  (read-bitmap (icons-path "bomb-32x32.png") #:try-@2x? #t))
 (define mred-bmp
   (make-object bitmap2% (icons-path "mred.xbm") 'xbm))
 (define nruter-bmp
   (make-object bitmap2% (local-path "nruter.xbm") 'xbm))
+(define gc-bmp
+  (read-bitmap (icons-path "recycle.png") #:try-@2x? #t))
 
 (define (add-label-direction label-h? l)
   (if (not label-h?)
@@ -2488,6 +2490,25 @@
 	     "Warp Pointer" edp 
 	     (lambda (b e)
                (send selector warp-pointer 5 5)))
+(let* ([w (send gc-bmp get-width)]
+       [h (send gc-bmp get-height)]
+       [c (new (class canvas%
+                 (super-new)
+                 (define/override (on-event e)
+                   (when (send e button-down?)
+                     (collect-garbage))))
+               [parent edp]
+               [stretchable-width #f]
+               [stretchable-height #f]
+               [vert-margin 2]
+               [horiz-margin 2]
+               [min-width w]
+               [min-height h])])
+  (register-collecting-blit c
+                            0 0 (send gc-bmp get-width) (send gc-bmp get-height)
+                            gc-bmp (make-bitmap w h #f)))
+  
+              
 
 (define (choose-next radios)
   (let loop ([l radios])