use Cairo's Quartz back-end for canvas buffering under Mac OS X + makes text rending look much better - makes drawing to a bitmap% different than drawing onscreen

collects/mred/private/wx/cocoa/dc.rkt

@@ -33,6 +33,30 @@
 (define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void))
 (define-appserv CGContextStrokePath (_fun _CGContextRef -> _void))
 
+(define quartz-bitmap%
+  (class object%
+    (init w h b&w? alpha?)
+    (super-new)
+    (define s
+      (cairo_quartz_surface_create CAIRO_FORMAT_ARGB32
+                                   w
+                                   h))
+
+    (define/public (ok?) #t)
+    (define/public (is-color?) #t)
+
+    (define width w)
+    (define height h)
+    (define/public (get-width) width)
+    (define/public (get-height) height)
+    
+    (define/public (get-cairo-surface) s)
+
+    (define/public (release-bitmap-storage)
+      (atomically
+       (cairo_surface_destroy s)
+       (set! s #f)))))
+
 (define dc%
   (class backing-dc%
     (init [(cnvs canvas)])
@@ -40,6 +64,10 @@
 
     (super-new)
 
+    ;; Use a quartz bitmap so that text looks good:
+    (define/override (get-bitmap%) quartz-bitmap%)
+    (define/override (can-combine-text? sz) #t)
+
     (define/override (get-backing-size xb yb)
       (send canvas get-backing-size xb yb))
 

collects/mred/private/wx/common/backing-dc.rkt

@@ -15,7 +15,8 @@
          on-backing-flush
          start-backing-retained
          end-backing-retained
-         reset-backing-retained)
+         reset-backing-retained
+         get-bitmap%)
 
 (define-local-member-name
   get-backing-size
@@ -23,7 +24,8 @@
   on-backing-flush
   start-backing-retained
   end-backing-retained
-  reset-backing-retained)
+  reset-backing-retained
+  get-bitmap%)
 
 (define backing-dc%
   (class (dc-mixin bitmap-dc-backend%)
@@ -83,12 +85,14 @@
              (log-error "unbalanced end-on-paint")
              (set! retained-counter (sub1 retained-counter))))))
 
+    (define/public (get-bitmap%) bitmap%)
+
     (define/override (get-cr)
       (or retained-cr
           (let ([w (box 0)]
                 [h (box 0)])
             (get-backing-size w h)
-            (let ([bm (get-backing-bitmap (unbox w) (unbox h))])
+            (let ([bm (get-backing-bitmap (get-bitmap%) (unbox w) (unbox h))])
               (internal-set-bitmap bm #t))
             (let ([cr (super get-cr)])
               (set! retained-cr cr)
@@ -110,7 +114,7 @@
        (when (zero? flush-suspends)
          (queue-backing-flush))))))
 
-(define (get-backing-bitmap w h)
+(define (get-backing-bitmap bitmap% w h)
   (make-object bitmap% w h #f #t))
 
 (define (release-backing-bitmap bm)

collects/racket/draw/cairo.rkt

@@ -52,6 +52,10 @@
 (define-cairo cairo_surface_destroy (_fun _cairo_surface_t -> _void)
   #:wrap (deallocator))
 
+(define-cairo cairo_quartz_surface_create
+  (_fun _int _uint _uint -> _cairo_surface_t)
+  #:make-fail make-not-available
+  #:wrap (allocator cairo_surface_destroy))
 (define-cairo cairo_quartz_surface_create_for_cg_context
   (_fun _CGContextRef _uint _uint -> _cairo_surface_t)
   #:make-fail make-not-available

collects/racket/draw/dc.rkt

@@ -125,7 +125,14 @@
     ;; set-auto-scroll : real real -> void
     ;;
     ;; used by a back-end to install canvas scrolling
-    set-auto-scroll))
+    set-auto-scroll
+
+    ;; can-combine-text? : real -> bool
+    ;;
+    ;; Return #t if text at given font size (already scaled)
+    ;;  looks good when drawn all at once (which allows kerning,
+    ;;  but may be spaced weirdly)
+    can-combine-text?))
 
 (define default-dc-backend%
   (class* object% (dc-backend<%>)
@@ -174,6 +181,9 @@
 
     (define/public (set-auto-scroll dx dy) (void))
 
+    (define/public (can-combine-text? sz)
+      (sz . > . 32.0))
+
     (super-new)))
 
 (define hilite-color (send the-color-database find-color "black"))
@@ -188,7 +198,8 @@
 
     (inherit flush-cr get-cr release-cr end-cr init-cr-matrix get-pango
              install-color dc-adjust-smoothing reset-clip
-             collapse-bitmap-b&w? call-with-cr-lock)
+             collapse-bitmap-b&w? call-with-cr-lock
+             can-combine-text?)
 
     (define-syntax-rule (with-cr default cr . body)
       (call-with-cr-lock
@@ -937,7 +948,8 @@
               [integral round]
               [x (if rotate? 0.0 x)]
               [y (if rotate? 0.0 y)])
-          (if combine?
+          (if (and combine?
+                   (can-combine-text? (* scale-y (send font get-point-size))))
               (let loop ([s s] [w 0.0] [h 0.0] [d 0.0] [a 0.0])
                 (cond
                  [(not s)

collects/racket/draw/local.rkt

@@ -39,4 +39,5 @@
   init-cr-matrix
   get-font-metrics-key
   install-color
-  dc-adjust-smoothing)
+  dc-adjust-smoothing
+  can-combine-text?)

collects/racket/draw/post-script-dc.rkt

@@ -118,6 +118,9 @@
           2
           0))
 
+    (define/override (can-combine-text? sz)
+      #t)
+
     (super-new)))
 
 (define post-script-dc% (dc-mixin dc-backend%))