diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 02a8db41..7c43f50d 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -6,7 +6,7 @@ "data-lib" ["base" #:version "6.2.900.17"] "syntax-color-lib" - ["draw-lib" #:version "1.10"] + ["draw-lib" #:version "1.11"] "snip-lib" "wxme-lib" "pict-lib" diff --git a/gui-lib/mred/private/wx/cocoa/dc.rkt b/gui-lib/mred/private/wx/cocoa/dc.rkt index a0a4d444..aaafd3c7 100644 --- a/gui-lib/mred/private/wx/cocoa/dc.rkt +++ b/gui-lib/mred/private/wx/cocoa/dc.rkt @@ -33,7 +33,7 @@ transparent?) (define canvas cnvs) - (inherit end-delay) + (inherit end-delay internal-get-bitmap internal-copy) (super-new [transparent? transparent?]) (define gl #f) @@ -67,6 +67,14 @@ (make-window-bitmap w h (send canvas get-cocoa-window) trans? (send canvas is-flipped?))) + + (def/override (copy [real? x] [real? y] [nonnegative-real? w] [nonnegative-real? h] + [real? x2] [real? y2]) + (internal-copy x y w h x2 y2 + (lambda (cr x y w h x2 y2) + (define bm (internal-get-bitmap)) + (and bm + (send bm do-self-copy cr x y w h x2 y2))))) (define/override (can-combine-text? sz) #t) @@ -236,6 +244,36 @@ #t)] [else #f])) + (define/override (do-self-copy cr x y w h x2 y2) + (define bs (get-backing-scale)) + (define s (cairo_get_target cr)) + (cairo_surface_flush s) + (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) + (CGContextDrawLayerAtPoint cg + (make-NSPoint x2 y2) + new-layer) + (CGContextScaleCTM cg (/ bs) (/ bs)) + (CGLayerRelease new-layer) + (cairo_surface_mark_dirty s)) + #t) + (define s-bm #f) (define/override (get-cairo-surface) ;; Convert to a platform bitmap, which Cairo understands diff --git a/gui-lib/mred/private/wxme/editor-canvas.rkt b/gui-lib/mred/private/wxme/editor-canvas.rkt index 3fe25345..2a8b924a 100644 --- a/gui-lib/mred/private/wxme/editor-canvas.rkt +++ b/gui-lib/mred/private/wxme/editor-canvas.rkt @@ -628,12 +628,14 @@ (when clear? (let ([bg (get-canvas-background)]) (when bg - (let ([adc (get-dc)]) + (let* ([dx (box 0)] + [dy (box 0)] + [adc (get-dc-and-offset dx dy)]) (let ([b (send adc get-brush)] [p (send adc get-pen)]) (send adc set-brush bg 'solid) (send adc set-pen bg 1 'transparent) - (send adc draw-rectangle localx localy fw fh) + (send adc draw-rectangle (- localx (unbox dx)) (- localy (unbox dy)) fw fh) (send adc set-brush b) (send adc set-pen p)))))) (let ([x (box 0)] @@ -990,7 +992,7 @@ xmargin ymargin vw (- (+ new-fy vh) old-fy) xmargin (+ ymargin (- old-fy new-fy))) - (redraw xmargin ymargin + (redraw vx vy vw (- old-fy new-fy) #t))] [(and (old-fy . < . new-fy) @@ -1001,7 +1003,7 @@ vw (- (+ old-fy vh) new-fy) xmargin ymargin) (let ([d (- (+ old-fy vh) new-fy)]) - (redraw xmargin (+ ymargin d) + (redraw vx (+ vy d) vw (- vh d) #t)))] [else (repaint)])))