From f67eea2b7acf3ac1ea6d97da0b0e5c9a05df530b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 5 Aug 2010 07:44:39 -0600 Subject: [PATCH] yet more cocoa canvas repairs original commit: f716ae049a730cbc9fc17c974087cce78ababcc1 --- collects/mred/private/wx/cocoa/canvas.rkt | 59 +++++++++++++++++------ collects/mred/private/wx/cocoa/dc.rkt | 4 +- collects/mred/private/wx/cocoa/frame.rkt | 2 + collects/mred/private/wx/cocoa/panel.rkt | 4 ++ collects/mred/private/wx/cocoa/window.rkt | 4 ++ 5 files changed, 57 insertions(+), 16 deletions(-) diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index f7a149b0..6d5470bd 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -68,6 +68,28 @@ (CGContextStrokePath cg)) (tellv ctx restoreGraphicsState)))) +(define-objc-class CornerlessFrameView NSView + [] + (-a _void (drawRect: [_NSRect r]) + (let ([ctx (tell NSGraphicsContext currentContext)]) + (tellv ctx saveGraphicsState) + (let ([cg (tell #:type _CGContextRef ctx graphicsPort)] + [r (tell #:type _NSRect self bounds)]) + (CGContextSetRGBFillColor cg 0 0 0 1.0) + (let* ([l (NSPoint-x (NSRect-origin r))] + [t (NSPoint-y (NSRect-origin r))] + [b (+ t (NSSize-height (NSRect-size r)))] + [r (+ l (NSSize-width (NSRect-size r)))]) + (CGContextAddLines cg + (vector + (make-NSPoint r (+ t scroll-width)) + (make-NSPoint r b) + (make-NSPoint l b) + (make-NSPoint l t) + (make-NSPoint (- r scroll-width) t)))) + (CGContextStrokePath cg)) + (tellv ctx restoreGraphicsState)))) + (define-cocoa NSSetFocusRingStyle (_fun _int -> _void)) (define-cocoa NSRectFill (_fun _NSRect -> _void)) @@ -136,6 +158,7 @@ get-eventspace make-graphics-context is-shown-to-root? + is-shown-to-before-root? move get-x get-y on-size register-as-child @@ -199,7 +222,9 @@ (tell (tell (cond [is-combo? NSView] [(memq 'control-border style) FocusView] - [(memq 'border style) FrameView] + [(memq 'border style) (if (memq 'vscroll style) + CornerlessFrameView + FrameView)] [else NSView]) alloc) initWithFrame: #:type _NSRect (make-NSRect (make-NSPoint x y) @@ -236,19 +261,22 @@ (define/public (get-dc) dc) (define/public (fix-dc) - (let ([p (tell #:type _NSPoint content-cocoa - convertPoint: #:type _NSPoint (make-NSPoint 0 0) - toView: #f)] - [xb (box 0)] - [yb (box 0)]) - (get-client-size xb yb) - (send dc reset-bounds - (+ (NSPoint-x p) (if is-combo? 2 0)) - (- (NSPoint-y p) (if is-combo? 22 0)) - (max 1 (- (unbox xb) (if is-combo? 22 0))) - (unbox yb) - (if auto-scroll? (scroll-pos h-scroller) 0) - (if auto-scroll? (scroll-pos v-scroller) 0)))) + (when (dc . is-a? . dc%) + (if (is-shown-to-before-root?) + (let ([p (tell #:type _NSPoint content-cocoa + convertPoint: #:type _NSPoint (make-NSPoint 0 0) + toView: #f)] + [xb (box 0)] + [yb (box 0)]) + (get-client-size xb yb) + (send dc reset-bounds + (+ (NSPoint-x p) (if is-combo? 2 0)) + (- (NSPoint-y p) (if is-combo? 22 0)) + (max 1 (- (unbox xb) (if is-combo? 22 0))) + (unbox yb) + (if auto-scroll? (scroll-pos h-scroller) 0) + (if auto-scroll? (scroll-pos v-scroller) 0))) + (send dc reset-bounds 0 0 0 0 0 0)))) (define/override (get-client-size xb yb) (super get-client-size xb yb) @@ -267,7 +295,8 @@ (define/override (show on?) ;; FIXME: what if we're in the middle of an on-paint? - (super show on?)) + (super show on?) + (fix-dc)) (define/private (do-set-size x y w h) (super set-size x y w h) diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index ab7eb832..dd55ba0d 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -15,7 +15,8 @@ CGContextSetRGBFillColor CGContextFillRect CGContextAddRect - CGContextStrokePath) + CGContextStrokePath + CGContextAddLines) (define _CGContextRef (_cpointer 'CGContextRef)) (define-appserv CGContextTranslateCTM (_fun _CGContextRef _CGFloat _CGFloat -> _void)) @@ -24,6 +25,7 @@ (define-appserv CGContextSetRGBFillColor (_fun _CGContextRef _CGFloat _CGFloat _CGFloat _CGFloat -> _void)) (define-appserv CGContextFillRect (_fun _CGContextRef _NSRect -> _void)) (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 CGContextConvertPointToUserSpace (_fun _CGContextRef _NSPoint -> _NSPoint)) (define-appserv CGContextConvertSizeToUserSpace (_fun _CGContextRef _NSSize -> _NSSize)) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 81b5f05b..3c843bde 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -240,6 +240,8 @@ (define/override (is-shown-to-root?) (is-shown?)) + (define/override (is-shown-to-before-root?) #t) + (define/override (is-parent-enabled-to-root?) #t) diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt index 0c34141c..84423107 100644 --- a/collects/mred/private/wx/cocoa/panel.rkt +++ b/collects/mred/private/wx/cocoa/panel.rkt @@ -44,6 +44,10 @@ (if on? (cons child children) (remq child children)))))) + + (define/override (show on?) + (super show on?) + (fix-dc)) (def/public-unimplemented on-paint) (define/public (set-item-cursor x y) (void)) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 81d09aac..91fbedb1 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -213,6 +213,10 @@ (and (is-shown?) (send parent is-shown-to-root?))) + (define/public (is-shown-to-before-root?) + (and (is-shown?) + (send parent is-shown-to-before-root?))) + (define enabled? #t) (define/public (is-enabled-to-root?) (and (is-window-enabled?) (is-parent-enabled-to-root?)))