From f30792e085b60da3ee3a111c33f5a3694353889c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 1 Aug 2010 06:57:03 -0600 Subject: [PATCH] fixes to bitmap%, especially mask vs. alpha mode original commit: 439683af5e938a0662139e5af90f65103d8c53cb --- collects/mred/private/wx/cocoa/image.rkt | 5 +++-- collects/mred/private/wx/cocoa/procs.rkt | 2 +- collects/mred/private/wx/cocoa/queue.rkt | 4 ++-- collects/mred/private/wx/gtk/message.rkt | 6 ++++-- collects/mred/private/wx/gtk/pixbuf.rkt | 5 +++-- 5 files changed, 13 insertions(+), 9 deletions(-) diff --git a/collects/mred/private/wx/cocoa/image.rkt b/collects/mred/private/wx/cocoa/image.rkt index 808b9b42..4d4de0bd 100644 --- a/collects/mred/private/wx/cocoa/image.rkt +++ b/collects/mred/private/wx/cocoa/image.rkt @@ -57,8 +57,9 @@ [h (send bm get-height)] [str (make-bytes (* w h 4) 255)]) (send bm get-argb-pixels 0 0 w h str #f) - (when (send bm get-loaded-mask) - (send bm get-argb-pixels 0 0 w h str #t)) + (let ([mask (send bm get-loaded-mask)]) + (when mask + (send mask get-argb-pixels 0 0 w h str #t))) (as-entry (lambda () (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)]) diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index da4f6ec1..3d7e2c10 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -95,7 +95,7 @@ (define-unimplemented draw-tab-base) (define-unimplemented key-symbol-to-integer) (define (get-control-font-size) 13) -(define-unimplemented cancel-quit) +(define (cancel-quit) (void)) (define-unimplemented fill-private-color) (define (flush-display) (void)) (define-unimplemented write-resource) diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index 3211db05..9e45b71f 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -33,9 +33,9 @@ (define-objc-class MyApplicationDelegate NSObject #:protocols (NSApplicationDelegate) [] - [-a _BOOL (applicationShouldTerminate: [_id app]) + [-a _int (applicationShouldTerminate: [_id app]) (queue-quit-event) - #f] + 0] [-a _BOOL (openPreferences: [_id app]) (log-error "prefs") #t]) diff --git a/collects/mred/private/wx/gtk/message.rkt b/collects/mred/private/wx/gtk/message.rkt index fdd2397c..b29ba9d1 100644 --- a/collects/mred/private/wx/gtk/message.rkt +++ b/collects/mred/private/wx/gtk/message.rkt @@ -56,8 +56,10 @@ [(caution) (gtk_image_new_from_stock "gtk-dialog-warning" icon-size)] [(stop) (gtk_image_new_from_stock "gtk-dialog-error" icon-size)] [else (gtk_image_new_from_stock "gtk-dialog-question" icon-size)]) - (gtk_image_new_from_pixbuf - (bitmap->pixbuf label))))] + (if (send label ok?) + (gtk_image_new_from_pixbuf + (bitmap->pixbuf label)) + (gtk_label_new_with_mnemonic ""))))] [no-show? (memq 'deleted style)]) (set-auto-size) diff --git a/collects/mred/private/wx/gtk/pixbuf.rkt b/collects/mred/private/wx/gtk/pixbuf.rkt index d94c74d5..cfcbca4e 100644 --- a/collects/mred/private/wx/gtk/pixbuf.rkt +++ b/collects/mred/private/wx/gtk/pixbuf.rkt @@ -36,8 +36,9 @@ [h (send bm get-height)] [str (make-bytes (* w h 4) 255)]) (send bm get-argb-pixels 0 0 w h str #f) - (when (send bm get-loaded-mask) - (send bm get-argb-pixels 0 0 w h str #t)) + (let ([mask (send bm get-loaded-mask)]) + (when mask + (send mask get-argb-pixels 0 0 w h str #t))) (as-entry (lambda () (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])