suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cocoa: control-border in canvas%

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-09 09:42:55 -06:00
parent 815278fe43
commit 631f0a6e34
1 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -27,7 +27,8 @@
;; ----------------------------------------
(import-class NSView NSGraphicsContext NSScroller NSComboBox NSWindow NSImageView)
(import-class NSView NSGraphicsContext NSScroller NSComboBox NSWindow
NSImageView NSTextFieldCell)
(import-protocol NSComboBoxDelegate)
@ -116,11 +117,22 @@
(define-cocoa NSSetFocusRingStyle (_fun _int -> _void))
(define-cocoa NSRectFill (_fun _NSRect -> _void))
(define bezel-cell
(tell (tell NSTextFieldCell alloc) initTextCell: #:type _NSString ""))
(tellv bezel-cell setBezeled: #:type _BOOL #t)
(define-objc-class FocusView NSView
[on?]
(-a _void (setFocusState: [_BOOL is-on?])
(set! on? is-on?))
(-a _void (drawRect: [_NSRect r])
(let ([f (tell #:type _NSRect self frame)])
(tellv bezel-cell
drawWithFrame: #:type _NSRect (make-NSRect (make-NSPoint 2 2)
(let ([s (NSRect-size r)])
(make-NSSize (- (NSSize-width s) 4)
(- (NSSize-height s) 4))))
inView: self))
(when on?
(let ([ctx (tell NSGraphicsContext currentContext)])
(tellv ctx saveGraphicsState)