diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 7a5e4ab3a2..c7052e65d6 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -10,6 +10,7 @@ "types.rkt" "window.rkt" "dc.rkt" + "queue.rkt" "../common/event.rkt" "../common/queue.rkt" "../../syntax.rkt" @@ -40,7 +41,9 @@ (CGContextFillRect cg (make-NSRect (make-NSPoint 0 0) (make-NSSize 32000 32000)))) (tellv ctx restoreGraphicsState)))) - (send wx queue-paint)) + (send wx queue-paint) + ;; ensure that `nextEventMatchingMask:' returns + (post-dummy-event)) (-a _void (viewWillMoveToWindow: [_id w]) (when wx (queue-window-event wx (lambda () (send wx fix-dc))))) @@ -76,15 +79,26 @@ (define canvas-style style) + ;; Avoid multiple queued paints: (define paint-queued? #f) + ;; To handle paint requests that happen while on-paint + ;; is being called already: + (define now-drawing? #f) + (define refresh-after-drawing? #f) + (define/public (queue-paint) ;; can be called from any thread, including the event-pump thread (unless paint-queued? (set! paint-queued? #t) (queue-window-event this (lambda () (set! paint-queued? #f) - (on-paint))))) - + (set! now-drawing? #t) + (fix-dc) + (on-paint) + (set! now-drawing? #f) + (when refresh-after-drawing? + (set! refresh-after-drawing? #f) + (refresh)))))) (define/override (refresh) (tellv content-cocoa setNeedsDisplay: #:type _BOOL #t)) @@ -312,9 +326,13 @@ (define/public (get-canvas-background) bg-col) (define/public (set-canvas-background col) (set! bg-col col)) (define/public (get-canvas-background-for-clearing) - (and (not (memq 'transparent canvas-style)) - (not (memq 'no-autoclear canvas-style)) - bg-col)) + (if now-drawing? + (begin + (set! refresh-after-drawing? #t) + #f) + (and (not (memq 'transparent canvas-style)) + (not (memq 'no-autoclear canvas-style)) + bg-col))) (define/public (do-scroll direction scroller) ;; Called from the Cocoa handler thread diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index a4d5f99d4c..dddec0dfb7 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -19,6 +19,7 @@ set-eventspace-hook! set-front-hook! set-menu-bar-hooks! + post-dummy-event ;; from common/queue: current-eventspace diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt index 443f87393f..e5cd5cf2f6 100644 --- a/collects/mred/private/wx/gtk/queue.rkt +++ b/collects/mred/private/wx/gtk/queue.rkt @@ -37,7 +37,7 @@ (define-glib g_main_context_query (_fun _GMainContext _int _pointer - _GPollFD-pointer + _pointer ;; GPollFD array _int -> _int)) diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/dc.rkt index cd3fae0cec..40e2d19e17 100644 --- a/collects/racket/draw/dc.rkt +++ b/collects/racket/draw/dc.rkt @@ -759,7 +759,11 @@ (do-text cr #f s 0 0 font combine? offset 0.0))) (define/private (do-text cr draw? s x y font combine? offset angle) - (let ([s (if (zero? offset) s (substring s offset))]) + (let* ([s (if (zero? offset) + s + (substring s offset))] + [blank? (equal? s "")] + [s (if (and (not draw?) blank?) " " s)]) (unless context (set! context (pango_cairo_create_context cr))) (set-font-antialias context (send font get-smoothing)) @@ -788,7 +792,9 @@ (void) (let ([logical (make-PangoRectangle 0 0 0 0)]) (pango_layout_get_extents layout #f logical) - (values (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE))) + (values (if blank? + 0.0 + (integral (/ (PangoRectangle-width logical) (exact->inexact PANGO_SCALE)))) (integral (/ (PangoRectangle-height logical) (exact->inexact PANGO_SCALE))) (integral (/ (- (PangoRectangle-height logical) (pango_layout_get_baseline layout)) @@ -820,7 +826,7 @@ (pango_layout_get_baseline layout)) (exact->inexact PANGO_SCALE)))] [la 0.0]) - (values (+ w lw) (max h lh) (max d ld) (max a la)))))))))) + (values (if blank? 0.0 (+ w lw)) (max h lh) (max d ld) (max a la)))))))))) (def/public (get-char-width) 10.0)