yet more cocoa canvas repairs

original commit: f716ae049a730cbc9fc17c974087cce78ababcc1
This commit is contained in:
Matthew Flatt 2010-08-05 07:44:39 -06:00
parent 1ef742fd91
commit f67eea2b7a
5 changed files with 57 additions and 16 deletions

View File

@ -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,6 +261,8 @@
(define/public (get-dc) dc)
(define/public (fix-dc)
(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)]
@ -248,7 +275,8 @@
(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))))
(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)

View File

@ -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))

View File

@ -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)

View File

@ -45,6 +45,10 @@
(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))
(def/public-unimplemented get-item-cursor)))

View File

@ -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?)))