From 33395ae1cf0783ed42c14ddb48fd724ee2f0bbbb Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 24 Nov 2015 15:01:25 -0700
Subject: [PATCH] Cocoa: canvas DC `copy` improvement

---
 gui-lib/mred/private/wx/cocoa/cg.rkt        |  1 +
 gui-lib/mred/private/wx/cocoa/dc.rkt        | 47 +++++++++------------
 gui-lib/mred/private/wxme/editor-canvas.rkt |  8 +++-
 3 files changed, 28 insertions(+), 28 deletions(-)

diff --git a/gui-lib/mred/private/wx/cocoa/cg.rkt b/gui-lib/mred/private/wx/cocoa/cg.rkt
index 48d148a3..b57f0ac0 100644
--- a/gui-lib/mred/private/wx/cocoa/cg.rkt
+++ b/gui-lib/mred/private/wx/cocoa/cg.rkt
@@ -29,6 +29,7 @@
 (define-appserv CGContextAddRect (_fun _CGContextRef _NSRect -> _void))
 (define-appserv CGContextAddLines (_fun _CGContextRef (v : (_vector i _NSPoint)) (_long = (vector-length v)) -> _void))
 (define-appserv CGContextStrokePath (_fun _CGContextRef -> _void))
+(define-appserv CGContextClipToRect (_fun _CGContextRef _NSRect -> _void))
 (define-appserv CGContextClipToRects (_fun _CGContextRef (_vector i _NSRect) _size -> _void))
 (define-appserv CGContextSetAlpha (_fun _CGContextRef _CGFloat -> _void))
 
diff --git a/gui-lib/mred/private/wx/cocoa/dc.rkt b/gui-lib/mred/private/wx/cocoa/dc.rkt
index aaafd3c7..77b784ec 100644
--- a/gui-lib/mred/private/wx/cocoa/dc.rkt
+++ b/gui-lib/mred/private/wx/cocoa/dc.rkt
@@ -211,13 +211,7 @@
                                        (cairo_matrix_t-y0 m)))
              (cairo_surface_flush s)
              (define cg (cairo_quartz_surface_get_cg_context s))
-             (begin
-               ;; A Cairo flush doesn't reset the clipping region. The
-               ;; implementation of clipping is that there's a saved
-               ;; GState that we can use to get back to the original
-               ;; clipping region, so restore (and save again) that state:
-               (CGContextRestoreGState cg)
-               (CGContextSaveGState cg))
+             (reset-cairo-clipping cg)
              (CGContextSaveGState cg)
              (CGContextConcatCTM cg trans)
              (let ([n (cairo_rectangle_list_t-num_rectangles rs)])
@@ -251,28 +245,29 @@
       (define cg (cairo_quartz_surface_get_cg_context s))
       (define orig-size (CGLayerGetSize layer))
       (atomically
-       (begin
-         ;; A Cairo flush doesn't reset the clipping region. The
-         ;; implementation of clipping is that there's a saved
-         ;; GState that we can use to get back to the original
-         ;; clipping region, so restore (and save again) that state:
-         (CGContextRestoreGState cg)
-         (CGContextSaveGState cg))
-       (define new-layer (CGLayerCreateWithContext cg (make-NSSize w h) #f))
-       (define new-cg (CGLayerGetContext new-layer))
-       (CGContextTranslateCTM new-cg 0 h)
-       (CGContextScaleCTM new-cg 1 -1)
-       (CGContextScaleCTM cg bs bs)
-       (CGContextDrawLayerAtPoint new-cg
-                                  (make-NSPoint (- x) (- (- (NSSize-height orig-size) y h)))
-                                  layer)
+       (reset-cairo-clipping cg)
+       (CGContextSaveGState cg)
+       (CGContextScaleCTM cg bs (- bs))
+       (define sz (CGLayerGetSize layer))
+       (define lh (NSSize-height sz))
+       (CGContextTranslateCTM cg 0 (- lh))
+       (CGContextClipToRect cg (make-NSRect
+                                (make-NSPoint x2 (- lh (+ y2 h)))
+                                (make-NSSize w h)))
        (CGContextDrawLayerAtPoint cg
-                                  (make-NSPoint x2 y2)
-                                  new-layer)
-       (CGContextScaleCTM cg (/ bs) (/ bs))
-       (CGLayerRelease new-layer)
+                                  (make-NSPoint (- x2 x) (- y y2))
+                                  layer)
+       (CGContextRestoreGState cg)
        (cairo_surface_mark_dirty s))
       #t)
+    
+    (define/private (reset-cairo-clipping cg)
+      ;; A Cairo flush doesn't reset the clipping region. The
+      ;; implementation of clipping is that there's a saved
+      ;; GState that we can use to get back to the original
+      ;; clipping region, so restore (and save again) that state:
+      (CGContextRestoreGState cg)
+      (CGContextSaveGState cg))
 
     (define s-bm #f)
     (define/override (get-cairo-surface)
diff --git a/gui-lib/mred/private/wxme/editor-canvas.rkt b/gui-lib/mred/private/wxme/editor-canvas.rkt
index 4ff6ded5..6bc82b1b 100644
--- a/gui-lib/mred/private/wxme/editor-canvas.rkt
+++ b/gui-lib/mred/private/wxme/editor-canvas.rkt
@@ -988,16 +988,19 @@
                  [(and (new-fy . < . old-fy)
                        (old-fy . < . (+ new-fy vh)))
                   (let ([dc (get-dc)])
+                    (begin-refresh-sequence)
                     (send dc copy
                           xmargin ymargin
                           vw (- (+ new-fy vh) old-fy)
                           xmargin (+ ymargin (- old-fy new-fy)))
                     (redraw vx vy
                             vw (- old-fy new-fy)
-                            #t))]
+                            #t)
+                    (end-refresh-sequence))]
                  [(and (old-fy . < . new-fy)
                        (new-fy . < . (+ old-fy vh)))
                   (let ([dc (get-dc)])
+                    (begin-refresh-sequence)
                     (send dc copy
                           xmargin (+ ymargin (- new-fy old-fy))
                           vw (- (+ old-fy vh) new-fy)
@@ -1005,7 +1008,8 @@
                     (let ([d (- (+ old-fy vh) new-fy)])
                       (redraw vx (+ vy d)
                               vw (- vh d)
-                              #t)))]
+                              #t))
+                    (end-refresh-sequence))]
                  [else (repaint)])))
             (repaint)))))