steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cocoa: maybe this is cleaner...

db4
John Benediktsson 2013-03-30 13:44:11 -07:00
parent a99f66f505
commit bf83eaccfc
3 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/cocoa/cocoa.factor
View File

@ -4,6 +4,7 @@ USING: compiler io kernel cocoa.runtime cocoa.subclassing
cocoa.messages cocoa.types sequences words vocabs parser cocoa.messages cocoa.types sequences words vocabs parser
core-foundation.bundles namespaces assocs hashtables core-foundation.bundles namespaces assocs hashtables
compiler.units lexer init ; compiler.units lexer init ;
FROM: cocoa.messages => selector ;
IN: cocoa IN: cocoa
: (remember-send) ( selector variable -- ) : (remember-send) ( selector variable -- )
@ -16,7 +17,16 @@ SYMBOL: sent-messages
SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ; SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ;
SYNTAX: ?-> scan-token [ remember-send ] [ <selector> drop ] bi ; SYNTAX: SEL:
scan-token
[ remember-send ]
[ <selector> suffix! \ selector suffix! ] bi ;
SYNTAX: SEND:
scan-token
[ remember-send ]
[ <selector> suffix! \ selector suffix! ]
[ suffix! \ lookup-sender suffix! ] tri ;
SYMBOL: super-sent-messages SYMBOL: super-sent-messages

11
basis/cocoa/messages/messages.factor
View File

@ -64,15 +64,8 @@ ERROR: no-objc-method name ;
: lookup-method ( selector -- method ) : lookup-method ( selector -- method )
dup ?lookup-method [ ] [ no-objc-method ] ?if ; dup ?lookup-method [ ] [ no-objc-method ] ?if ;
: (selector/sender) ( selector super? -- alien word ) : lookup-sender ( name -- method )
[ [ lookup-selector ] [ lookup-method ] bi ] lookup-method message-senders get at ;
[ super-message-senders message-senders ? get at ] bi* ; inline
: selector/sender ( selector -- alien word )
f (selector/sender) ; inline
: selector/super-sender ( selector -- alien word )
t (selector/sender) ; inline
MEMO: make-prepare-send ( selector method super? -- quot ) MEMO: make-prepare-send ( selector method super? -- quot )
[ [

14
basis/ui/backend/cocoa/views/views.factor
View File

@ -151,17 +151,13 @@ CLASS: FactorView < NSOpenGLView NSTextInput
METHOD: void prepareOpenGL [ METHOD: void prepareOpenGL [
?-> setWantsBestResolutionOpenGLSurface: self SEL: setWantsBestResolutionOpenGLSurface:
?-> backingScaleFactor -> respondsToSelector: c-bool> [
self "setWantsBestResolutionOpenGLSurface:" self SEND: setWantsBestResolutionOpenGLSurface:
lookup-selector -> respondsToSelector: c-bool> [ 1 swap execute( x x x -- )
self "setWantsBestResolutionOpenGLSurface:" self SEND: backingScaleFactor execute( x x -- x )
selector/sender 1 swap execute( x x x -- )
self "backingScaleFactor"
selector/sender execute( x x -- x )
dup 1.0 > [ dup 1.0 > [
gl-scale-factor set-global t retina? set-global gl-scale-factor set-global t retina? set-global
] [ drop ] if ] [ drop ] if