yet more cocoa canvas repairs
original commit: f716ae049a730cbc9fc17c974087cce78ababcc1
This commit is contained in:
parent
1ef742fd91
commit
f67eea2b7a
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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?)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user