factor: -> -> send\, SUPER-> -> super-send\, SEL: -> sel\

locals-and-roots
Doug Coleman 2016-06-05 17:01:36 -07:00
parent e5bfe37ab1
commit 045077fd3f
18 changed files with 159 additions and 139 deletions

View File

@ -10,8 +10,8 @@ import: WebView
: rect ( -- rect ) 0 0 700 500 <CGRect> ; : rect ( -- rect ) 0 0 700 500 <CGRect> ;
: <WebView> ( -- id ) : <WebView> ( -- id )
WebView -> alloc WebView send\ alloc
rect f f -> initWithFrame:frameName:groupName: ; rect f f send\ initWithFrame:frameName:groupName: ;
CONSTANT: window-style CONSTANT: window-style
flags{ flags{
@ -25,12 +25,12 @@ CONSTANT: window-style
<WebView> rect window-style <ViewWindow> ; <WebView> rect window-style <ViewWindow> ;
: load-url ( window url -- ) : load-url ( window url -- )
[ -> contentView ] [ <NSString> ] bi* -> setMainFrameURL: ; [ send\ contentView ] [ <NSString> ] bi* send\ setMainFrameURL: ;
: webkit-demo ( -- ) : webkit-demo ( -- )
<WebWindow> <WebWindow>
[ -> center ] [ send\ center ]
[ f -> makeKeyAndOrderFront: ] [ f send\ makeKeyAndOrderFront: ]
[ "http://factorcode.org" load-url ] tri ; [ "http://factorcode.org" load-url ] tri ;
: run-webkit-demo ( -- ) : run-webkit-demo ( -- )

View File

@ -7,9 +7,9 @@ multiline words ;
in: cocoa.apple-script in: cocoa.apple-script
: run-apple-script ( str -- ) : run-apple-script ( str -- )
[ NSAppleScript -> alloc ] dip [ NSAppleScript send\ alloc ] dip
<NSString> -> initWithSource: -> autorelease <NSString> send\ initWithSource: send\ autorelease
f -> executeAndReturnError: drop ; f send\ executeAndReturnError: drop ;
SYNTAX: APPLESCRIPT: SYNTAX: APPLESCRIPT:
scan-new-word ";APPLESCRIPT" parse-multiline-string scan-new-word ";APPLESCRIPT" parse-multiline-string

View File

@ -4,16 +4,16 @@ USING: alien.c-types alien.syntax cocoa cocoa.classes
cocoa.runtime core-foundation.strings kernel sequences ; cocoa.runtime core-foundation.strings kernel sequences ;
in: cocoa.application in: cocoa.application
: <NSString> ( str -- alien ) <CFString> -> autorelease ; : <NSString> ( str -- alien ) <CFString> send\ autorelease ;
CONSTANT: NSApplicationDelegateReplySuccess 0 ; CONSTANT: NSApplicationDelegateReplySuccess 0 ;
CONSTANT: NSApplicationDelegateReplyCancel 1 ; CONSTANT: NSApplicationDelegateReplyCancel 1 ;
CONSTANT: NSApplicationDelegateReplyFailure 2 ; CONSTANT: NSApplicationDelegateReplyFailure 2 ;
: with-autorelease-pool ( quot -- ) : with-autorelease-pool ( quot -- )
NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline NSAutoreleasePool send\ new [ call ] [ send\ release ] bi* ; inline
: NSApp ( -- app ) NSApplication -> sharedApplication ; : NSApp ( -- app ) NSApplication send\ sharedApplication ;
CONSTANT: NSAnyEventMask 0xffffffff ; CONSTANT: NSAnyEventMask 0xffffffff ;
@ -24,24 +24,24 @@ FUNCTION: void NSBeep ( ) ;
: add-observer ( observer selector name object -- ) : add-observer ( observer selector name object -- )
[ [
[ NSNotificationCenter -> defaultCenter ] 2dip [ NSNotificationCenter send\ defaultCenter ] 2dip
sel_registerName sel_registerName
] 2dip -> addObserver:selector:name:object: ; ] 2dip send\ addObserver:selector:name:object: ;
: remove-observer ( observer -- ) : remove-observer ( observer -- )
[ NSNotificationCenter -> defaultCenter ] dip [ NSNotificationCenter send\ defaultCenter ] dip
-> removeObserver: ; send\ removeObserver: ;
: cocoa-app ( quot -- ) : cocoa-app ( quot -- )
[ call NSApp -> run ] with-cocoa ; inline [ call NSApp send\ run ] with-cocoa ; inline
: install-delegate ( receiver delegate -- ) : install-delegate ( receiver delegate -- )
-> alloc -> init -> setDelegate: ; send\ alloc send\ init send\ setDelegate: ;
: running.app? ( -- ? ) : running.app? ( -- ? )
! Test if we're running a .app. ! Test if we're running a .app.
".app" ".app"
NSBundle -> mainBundle -> bundlePath CF>string NSBundle send\ mainBundle send\ bundlePath CF>string
subseq? ; subseq? ;
: assert.app ( message -- ) : assert.app ( message -- )

View File

@ -8,13 +8,25 @@ HELP: ->
{ $description "A sugared form of the following:" } { $description "A sugared form of the following:" }
{ $code "\"selector\" send" } ; { $code "\"selector\" send" } ;
HELP: send\
{ $syntax "send\ selector" }
{ $values { "selector" "an Objective C method name" } }
{ $description "A sugared form of the following:" }
{ $code "\"selector\" send" } ;
HELP: SUPER-> HELP: SUPER->
{ $syntax "-> selector" } { $syntax "-> selector" }
{ $values { "selector" "an Objective C method name" } } { $values { "selector" "an Objective C method name" } }
{ $description "A sugared form of the following:" } { $description "A sugared form of the following:" }
{ $code "\"selector\" send-super" } ; { $code "\"selector\" send-super" } ;
{ send super-send postpone\ -> postpone\ SUPER-> } related-words HELP: super-send\
{ $syntax "-> selector" }
{ $values { "selector" "an Objective C method name" } }
{ $description "A sugared form of the following:" }
{ $code "\"selector\" send-super" } ;
{ send super-send postpone\ -> postpone\ send\ postpone\ SUPER-> postpone\ super-send\ } related-words
HELP: import: HELP: import:
{ $syntax "import: name" } { $syntax "import: name" }
@ -31,7 +43,9 @@ $nl
"Messages can be sent to classes and instances using a pair of parsing words:" "Messages can be sent to classes and instances using a pair of parsing words:"
{ $subsections { $subsections
postpone\ -> postpone\ ->
postpone\ send\
postpone\ SUPER-> postpone\ SUPER->
postpone\ super-send\
} }
"These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:" "These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:"
{ $subsections { $subsections

View File

@ -10,9 +10,9 @@ CLASS: Foo < NSObject
; ;
: test-foo ( -- ) : test-foo ( -- )
Foo -> alloc -> init Foo send\ alloc send\ init
dup 1.0 2.0 101.0 102.0 <CGRect> -> foo: dup 1.0 2.0 101.0 102.0 <CGRect> send\ foo:
-> release ; send\ release ;
{ } [ test-foo ] unit-test { } [ test-foo ] unit-test
@ -27,9 +27,9 @@ CLASS: Bar < NSObject
{ } [ { } [
Bar [ Bar [
-> alloc -> init send\ alloc send\ init
dup -> bar "x" set dup send\ bar "x" set
-> release send\ release
] compile-call ] compile-call
] unit-test ] unit-test
@ -47,8 +47,8 @@ CLASS: Bar < NSObject
{ 144 } [ { 144 } [
Bar [ Bar [
-> alloc -> init send\ alloc send\ init
dup 12 -> babb: dup 12 send\ babb:
swap -> release swap send\ release
] compile-call ] compile-call
] unit-test ] unit-test

View File

@ -13,11 +13,16 @@ symbol: sent-messages
sent-messages (remember-send) ; sent-messages (remember-send) ;
SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ; SYNTAX: -> scan-token dup remember-send suffix! \ send suffix! ;
SYNTAX: send\ scan-token dup remember-send suffix! \ send suffix! ;
SYNTAX: SEL: SYNTAX: SEL:
scan-token scan-token
[ remember-send ] [ remember-send ]
[ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ; [ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
SYNTAX: sel\
scan-token
[ remember-send ]
[ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
symbol: super-sent-messages symbol: super-sent-messages
@ -25,6 +30,7 @@ symbol: super-sent-messages
super-sent-messages (remember-send) ; super-sent-messages (remember-send) ;
SYNTAX: SUPER-> scan-token dup remember-super-send suffix! \ super-send suffix! ; SYNTAX: SUPER-> scan-token dup remember-super-send suffix! \ super-send suffix! ;
SYNTAX: super-send\ scan-token dup remember-super-send suffix! \ super-send suffix! ;
symbol: frameworks symbol: frameworks

View File

@ -5,27 +5,27 @@ core-foundation.strings kernel splitting ;
in: cocoa.dialogs in: cocoa.dialogs
: <NSOpenPanel> ( -- panel ) : <NSOpenPanel> ( -- panel )
NSOpenPanel -> openPanel NSOpenPanel send\ openPanel
dup 1 -> setCanChooseFiles: dup 1 send\ setCanChooseFiles:
dup 0 -> setCanChooseDirectories: dup 0 send\ setCanChooseDirectories:
dup 1 -> setResolvesAliases: dup 1 send\ setResolvesAliases:
dup 1 -> setAllowsMultipleSelection: ; dup 1 send\ setAllowsMultipleSelection: ;
: <NSDirPanel> ( -- panel ) <NSOpenPanel> : <NSDirPanel> ( -- panel ) <NSOpenPanel>
dup 1 -> setCanChooseDirectories: ; dup 1 send\ setCanChooseDirectories: ;
: <NSSavePanel> ( -- panel ) : <NSSavePanel> ( -- panel )
NSSavePanel -> savePanel NSSavePanel send\ savePanel
dup 1 -> setCanChooseFiles: dup 1 send\ setCanChooseFiles:
dup 0 -> setCanChooseDirectories: dup 0 send\ setCanChooseDirectories:
dup 0 -> setAllowsMultipleSelection: ; dup 0 send\ setAllowsMultipleSelection: ;
CONSTANT: NSOKButton 1 ; CONSTANT: NSOKButton 1 ;
CONSTANT: NSCancelButton 0 ; CONSTANT: NSCancelButton 0 ;
: (open-panel) ( panel -- paths ) : (open-panel) ( panel -- paths )
dup -> runModal NSOKButton = dup send\ runModal NSOKButton =
[ -> filenames CF>string-array ] [ drop f ] if ; [ send\ filenames CF>string-array ] [ drop f ] if ;
: open-panel ( -- paths ) <NSOpenPanel> (open-panel) ; : open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
@ -36,5 +36,5 @@ CONSTANT: NSCancelButton 0 ;
: save-panel ( path -- path/f ) : save-panel ( path -- path/f )
[ <NSSavePanel> dup ] dip [ <NSSavePanel> dup ] dip
split-path -> runModalForDirectory:file: NSOKButton = split-path send\ runModalForDirectory:file: NSOKButton =
[ -> filename CF>string ] [ drop f ] if ; [ send\ filename CF>string ] [ drop f ] if ;

View File

@ -17,7 +17,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16 ;
] with-destructors ; inline ] with-destructors ; inline
:: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... ) :: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... )
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count object state stackbuf count send\ countByEnumeratingWithState:objects:count: :> items-count
items-count 0 = [ items-count 0 = [
state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
items-count iota [ items nth quot call ] each items-count iota [ items nth quot call ] each

View File

@ -14,7 +14,7 @@ HELP: super-send
HELP: objc-class HELP: objc-class
{ $values { "string" string } { "class" alien } } { $values { "string" string } { "class" alien } }
{ $description "Outputs the Objective C class named by " { $snippet "string" } ". This class can then be used as the receiver in message sends calling class methods, for example:" { $description "Outputs the Objective C class named by " { $snippet "string" } ". This class can then be used as the receiver in message sends calling class methods, for example:"
{ $code "NSMutableArray -> alloc" } } { $code "NSMutableArray send\ alloc" } }
{ $errors "Throws an error if there is no class named by " { $snippet "string" } "." } ; { $errors "Throws an error if there is no class named by " { $snippet "string" } "." } ;
HELP: objc-meta-class HELP: objc-meta-class

View File

@ -6,15 +6,15 @@ in: cocoa.nibs
: load-nib ( name -- ) : load-nib ( name -- )
NSBundle NSBundle
swap <NSString> NSApp -> loadNibNamed:owner: swap <NSString> NSApp send\ loadNibNamed:owner:
drop ; drop ;
: nib-named ( nib-name -- anNSNib ) : nib-named ( nib-name -- anNSNib )
<NSString> NSNib -> alloc swap f -> initWithNibNamed:bundle: <NSString> NSNib send\ alloc swap f send\ initWithNibNamed:bundle:
dup [ -> autorelease ] when ; dup [ send\ autorelease ] when ;
: nib-objects ( anNSNib -- objects/f ) : nib-objects ( anNSNib -- objects/f )
f f
{ void* } [ -> instantiateNibWithOwner:topLevelObjects: ] { void* } [ send\ instantiateNibWithOwner:topLevelObjects: ]
with-out-parameters with-out-parameters
swap [ CF>array ] [ drop f ] if ; swap [ CF>array ] [ drop f ] if ;

View File

@ -8,19 +8,19 @@ in: cocoa.pasteboard
CONSTANT: NSStringPboardType "NSStringPboardType" ; CONSTANT: NSStringPboardType "NSStringPboardType" ;
: pasteboard-string? ( pasteboard -- ? ) : pasteboard-string? ( pasteboard -- ? )
NSStringPboardType swap -> types CF>string-array member? ; NSStringPboardType swap send\ types CF>string-array member? ;
: pasteboard-string ( pasteboard -- str ) : pasteboard-string ( pasteboard -- str )
NSStringPboardType <NSString> -> stringForType: NSStringPboardType <NSString> send\ stringForType:
dup [ CF>string ] when ; dup [ CF>string ] when ;
: set-pasteboard-types ( seq pasteboard -- ) : set-pasteboard-types ( seq pasteboard -- )
swap <CFArray> -> autorelease f -> declareTypes:owner: drop ; swap <CFArray> send\ autorelease f send\ declareTypes:owner: drop ;
: set-pasteboard-string ( str pasteboard -- ) : set-pasteboard-string ( str pasteboard -- )
NSStringPboardType <NSString> NSStringPboardType <NSString>
dup 1array pick set-pasteboard-types dup 1array pick set-pasteboard-types
[ swap <NSString> ] dip -> setString:forType: drop ; [ swap <NSString> ] dip send\ setString:forType: drop ;
: pasteboard-error ( error -- f ) : pasteboard-error ( error -- f )
"Pasteboard does not hold a string" <NSString> "Pasteboard does not hold a string" <NSString>

View File

@ -8,10 +8,10 @@ core-foundation.utilities fry io.backend kernel macros math
quotations sequences ; quotations sequences ;
in: cocoa.plists in: cocoa.plists
: >plist ( value -- plist ) >cf -> autorelease ; : >plist ( value -- plist ) >cf send\ autorelease ;
: write-plist ( assoc path -- ) : write-plist ( assoc path -- )
[ >plist ] [ normalize-path <NSString> ] bi* 0 -> writeToFile:atomically: [ >plist ] [ normalize-path <NSString> ] bi* 0 send\ writeToFile:atomically:
[ "write-plist failed" throw ] unless ; [ "write-plist failed" throw ] unless ;
defer: plist> defer: plist>
@ -19,30 +19,30 @@ defer: plist>
<PRIVATE <PRIVATE
: (plist-NSNumber>) ( NSNumber -- number ) : (plist-NSNumber>) ( NSNumber -- number )
dup -> doubleValue dup >integer = dup send\ doubleValue dup >integer =
[ -> longLongValue ] [ -> doubleValue ] if ; [ send\ longLongValue ] [ send\ doubleValue ] if ;
: (plist-NSData>) ( NSData -- byte-array ) : (plist-NSData>) ( NSData -- byte-array )
dup -> length <byte-array> [ -> getBytes: ] keep ; dup send\ length <byte-array> [ send\ getBytes: ] keep ;
: (plist-NSArray>) ( NSArray -- vector ) : (plist-NSArray>) ( NSArray -- vector )
[ plist> ] NSFastEnumeration-map ; [ plist> ] NSFastEnumeration-map ;
: (plist-NSDictionary>) ( NSDictionary -- hashtable ) : (plist-NSDictionary>) ( NSDictionary -- hashtable )
dup [ [ nip ] [ -> valueForKey: ] 2bi [ plist> ] bi@ ] with dup [ [ nip ] [ send\ valueForKey: ] 2bi [ plist> ] bi@ ] with
NSFastEnumeration>hashtable ; NSFastEnumeration>hashtable ;
: (read-plist) ( NSData -- id ) : (read-plist) ( NSData -- id )
NSPropertyListSerialization swap kCFPropertyListImmutable f NSPropertyListSerialization swap kCFPropertyListImmutable f
{ void* } { void* }
[ -> propertyListFromData:mutabilityOption:format:errorDescription: ] [ send\ propertyListFromData:mutabilityOption:format:errorDescription: ]
with-out-parameters with-out-parameters
[ -> release "read-plist failed" throw ] when* ; [ send\ release "read-plist failed" throw ] when* ;
MACRO: objc-class-case ( alist -- quot ) MACRO: objc-class-case ( alist -- quot )
[ [
dup callable? dup callable?
[ first2 [ '[ dup _ execute -> isKindOfClass: c-bool> ] ] dip 2array ] [ first2 [ '[ dup _ execute send\ isKindOfClass: c-bool> ] ] dip 2array ]
unless unless
] map '[ _ cond ] ; ] map '[ _ cond ] ;
@ -63,5 +63,5 @@ ERROR: invalid-plist-object object ;
: read-plist ( path -- assoc ) : read-plist ( path -- assoc )
normalize-path <NSString> normalize-path <NSString>
NSData swap -> dataWithContentsOfFile: NSData swap send\ dataWithContentsOfFile:
[ (read-plist) plist> ] [ "read-plist failed" throw ] if* ; [ (read-plist) plist> ] [ "read-plist failed" throw ] if* ;

View File

@ -44,17 +44,17 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
M: cocoa-ui-backend (make-pixel-format) M: cocoa-ui-backend (make-pixel-format)
nip >NSOpenGLPFA-int-array nip >NSOpenGLPFA-int-array
NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ; NSOpenGLPixelFormat send\ alloc swap send\ initWithAttributes: ;
M: cocoa-ui-backend (free-pixel-format) M: cocoa-ui-backend (free-pixel-format)
handle>> -> release ; handle>> send\ release ;
M: cocoa-ui-backend (pixel-format-attribute) M: cocoa-ui-backend (pixel-format-attribute)
[ handle>> ] [ >NSOpenGLPFA ] bi* [ handle>> ] [ >NSOpenGLPFA ] bi*
[ drop f ] [ drop f ]
[ [
first first
{ int } [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] { int } [ swap 0 send\ getValues:forAttribute:forVirtualScreen: ]
with-out-parameters with-out-parameters
] if-empty ; ] if-empty ;
@ -69,7 +69,7 @@ M: pasteboard set-clipboard-contents
handle>> set-pasteboard-string ; handle>> set-pasteboard-string ;
: init-clipboard ( -- ) : init-clipboard ( -- )
NSPasteboard -> generalPasteboard <pasteboard> NSPasteboard send\ generalPasteboard <pasteboard>
clipboard set-global clipboard set-global
<clipboard> selection set-global ; <clipboard> selection set-global ;
@ -82,32 +82,32 @@ M: pasteboard set-clipboard-contents
! after register-window. ! after register-window.
dup { 0 0 } = [ dup { 0 0 } = [
drop drop
ui-windows get-global length 1 <= [ -> center ] [ ui-windows get-global length 1 <= [ send\ center ] [
ui-windows get-global last second window-loc>> ui-windows get-global last second window-loc>>
dupd first2 <CGPoint> -> cascadeTopLeftFromPoint: dupd first2 <CGPoint> send\ cascadeTopLeftFromPoint:
-> setFrameTopLeftPoint: send\ setFrameTopLeftPoint:
] if ] if
] [ first2 <CGPoint> -> setFrameTopLeftPoint: ] if ; ] [ first2 <CGPoint> send\ setFrameTopLeftPoint: ] if ;
M: cocoa-ui-backend set-title ( string world -- ) M: cocoa-ui-backend set-title ( string world -- )
handle>> window>> swap <NSString> -> setTitle: ; handle>> window>> swap <NSString> send\ setTitle: ;
: enter-fullscreen ( world -- ) : enter-fullscreen ( world -- )
handle>> view>> handle>> view>>
NSScreen -> mainScreen NSScreen send\ mainScreen
f -> enterFullScreenMode:withOptions: f send\ enterFullScreenMode:withOptions:
drop ; drop ;
: exit-fullscreen ( world -- ) : exit-fullscreen ( world -- )
handle>> handle>>
[ view>> f -> exitFullScreenModeWithOptions: ] [ view>> f send\ exitFullScreenModeWithOptions: ]
[ [ window>> ] [ view>> ] bi -> makeFirstResponder: drop ] bi ; [ [ window>> ] [ view>> ] bi send\ makeFirstResponder: drop ] bi ;
M: cocoa-ui-backend (set-fullscreen) ( world ? -- ) M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
[ enter-fullscreen ] [ exit-fullscreen ] if ; [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend (fullscreen?) ( world -- ? ) M: cocoa-ui-backend (fullscreen?) ( world -- ? )
handle>> view>> -> isInFullScreenMode zero? not ; handle>> view>> send\ isInFullScreenMode zero? not ;
! XXX: Until someone tests OSX with a tiling window manager, ! XXX: Until someone tests OSX with a tiling window manager,
! dialog-window is the same as normal-title-window ! dialog-window is the same as normal-title-window
@ -127,8 +127,8 @@ CONSTANT: window-control>styleMask
window-controls>> window-control>styleMask symbols>flags ; window-controls>> window-control>styleMask symbols>flags ;
: make-context-transparent ( view -- ) : make-context-transparent ( view -- )
-> openGLContext send\ openGLContext
0 int <ref> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ; 0 int <ref> NSOpenGLCPSurfaceOpacity send\ setValues:forParameter: ;
M:: cocoa-ui-backend (open-window) ( world -- ) M:: cocoa-ui-backend (open-window) ( world -- )
world [ [ dim>> ] dip <FactorView> ] world [ [ dim>> ] dip <FactorView> ]
@ -136,27 +136,27 @@ M:: cocoa-ui-backend (open-window) ( world -- )
world window-controls>> textured-background swap member-eq? world window-controls>> textured-background swap member-eq?
[ view make-context-transparent ] when [ view make-context-transparent ] when
view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
view -> release view send\ release
world view register-window world view register-window
window world window-loc>> auto-position window world window-loc>> auto-position
world window save-position world window save-position
window install-window-delegate window install-window-delegate
view window <window-handle> world handle<< view window <window-handle> world handle<<
window f -> makeKeyAndOrderFront: window f send\ makeKeyAndOrderFront:
t world active?<< ; t world active?<< ;
M: cocoa-ui-backend (close-window) ( handle -- ) M: cocoa-ui-backend (close-window) ( handle -- )
[ [
view>> dup -> isInFullScreenMode zero? view>> dup send\ isInFullScreenMode zero?
[ drop ] [ drop ]
[ f -> exitFullScreenModeWithOptions: ] if [ f send\ exitFullScreenModeWithOptions: ] if
] [ window>> -> release ] bi ; ] [ window>> send\ release ] bi ;
M: cocoa-ui-backend (grab-input) ( handle -- ) M: cocoa-ui-backend (grab-input) ( handle -- )
0 CGAssociateMouseAndMouseCursorPosition drop 0 CGAssociateMouseAndMouseCursorPosition drop
CGMainDisplayID CGDisplayHideCursor drop CGMainDisplayID CGDisplayHideCursor drop
window>> -> frame CGRect>rect rect-center window>> send\ frame CGRect>rect rect-center
NSScreen -> screens 0 -> objectAtIndex: -> frame CGRect-h NSScreen send\ screens 0 send\ objectAtIndex: send\ frame CGRect-h
[ drop first ] [ swap second - ] 2bi <CGPoint> [ drop first ] [ swap second - ] 2bi <CGPoint>
[ GetCurrentButtonState zero? not ] [ yield ] while [ GetCurrentButtonState zero? not ] [ yield ] while
CGWarpMouseCursorPosition drop ; CGWarpMouseCursorPosition drop ;
@ -169,35 +169,35 @@ M: cocoa-ui-backend (ungrab-input) ( handle -- )
M: cocoa-ui-backend close-window ( gadget -- ) M: cocoa-ui-backend close-window ( gadget -- )
find-world [ find-world [
handle>> [ handle>> [
window>> -> close window>> send\ close
] when* ] when*
] when* ; ] when* ;
M: cocoa-ui-backend raise-window* ( world -- ) M: cocoa-ui-backend raise-window* ( world -- )
handle>> [ handle>> [
window>> dup f -> orderFront: -> makeKeyWindow window>> dup f send\ orderFront: send\ makeKeyWindow
NSApp 1 -> activateIgnoringOtherApps: NSApp 1 send\ activateIgnoringOtherApps:
] when* ; ] when* ;
M: window-handle select-gl-context ( handle -- ) M: window-handle select-gl-context ( handle -- )
view>> -> openGLContext -> makeCurrentContext ; view>> send\ openGLContext send\ makeCurrentContext ;
M: window-handle flush-gl-context ( handle -- ) M: window-handle flush-gl-context ( handle -- )
view>> -> openGLContext -> flushBuffer ; view>> send\ openGLContext send\ flushBuffer ;
M: cocoa-ui-backend beep ( -- ) M: cocoa-ui-backend beep ( -- )
NSBeep ; NSBeep ;
M: cocoa-ui-backend resize-window M: cocoa-ui-backend resize-window
[ handle>> window>> ] [ first2 ] bi* <CGSize> -> setContentSize: ; [ handle>> window>> ] [ first2 ] bi* <CGSize> send\ setContentSize: ;
M: cocoa-ui-backend system-alert M: cocoa-ui-backend system-alert
NSAlert -> alloc -> init -> autorelease [ NSAlert send\ alloc send\ init send\ autorelease [
{ {
[ swap <NSString> -> setInformativeText: ] [ swap <NSString> send\ setInformativeText: ]
[ swap <NSString> -> setMessageText: ] [ swap <NSString> send\ setMessageText: ]
[ "OK" <NSString> -> addButtonWithTitle: drop ] [ "OK" <NSString> send\ addButtonWithTitle: drop ]
[ -> runModal drop ] [ send\ runModal drop ]
} cleave } cleave
] [ 2drop ] if* ; ] [ 2drop ] if* ;
@ -223,7 +223,7 @@ M: cocoa-ui-backend (with-ui)
stop-io-thread stop-io-thread
init-thread-timer init-thread-timer
reset-thread-timer reset-thread-timer
NSApp -> run NSApp send\ run
] ui-running ] ui-running
] with-cocoa ; ] with-cocoa ;

View File

@ -12,7 +12,7 @@ in: ui.backend.cocoa.tools
: finder-run-files ( alien -- ) : finder-run-files ( alien -- )
CF>string-array listener-run-files CF>string-array listener-run-files
NSApp NSApplicationDelegateReplySuccess NSApp NSApplicationDelegateReplySuccess
-> replyToOpenOrPrint: ; send\ replyToOpenOrPrint: ;
: menu-run-files ( -- ) : menu-run-files ( -- )
open-panel [ listener-run-files ] when* ; open-panel [ listener-run-files ] when* ;
@ -71,8 +71,8 @@ CLASS: FactorServiceProvider < NSObject
: register-services ( -- ) : register-services ( -- )
NSApp NSApp
FactorServiceProvider -> alloc -> init FactorServiceProvider send\ alloc send\ init
-> setServicesProvider: ; send\ setServicesProvider: ;
FUNCTION: void NSUpdateDynamicServices ( ) ; FUNCTION: void NSUpdateDynamicServices ( ) ;

View File

@ -16,8 +16,8 @@ in: ui.backend.cocoa.views
! Issue #1453 ! Issue #1453
: button ( event -- n ) : button ( event -- n )
! Cocoa -> Factor UI button mapping ! Cocoa send\ Factor UI button mapping
-> buttonNumber { send\ buttonNumber {
{ 0 [ 1 ] } { 0 [ 1 ] }
{ 1 [ 3 ] } { 1 [ 3 ] }
{ 2 [ 2 ] } { 2 [ 2 ] }
@ -68,11 +68,11 @@ CONSTANT: key-codes
} ; } ;
: key-code ( event -- string ? ) : key-code ( event -- string ? )
dup -> keyCode key-codes at dup send\ keyCode key-codes at
[ t ] [ -> charactersIgnoringModifiers CF>string f ] ?if ; [ t ] [ send\ charactersIgnoringModifiers CF>string f ] ?if ;
: event-modifiers ( event -- modifiers ) : event-modifiers ( event -- modifiers )
-> modifierFlags modifiers modifier ; send\ modifierFlags modifiers modifier ;
: key-event>gesture ( event -- modifiers keycode action? ) : key-event>gesture ( event -- modifiers keycode action? )
[ event-modifiers ] [ key-code ] bi ; [ event-modifiers ] [ key-code ] bi ;
@ -81,7 +81,7 @@ CONSTANT: key-codes
swap window [ propagate-key-gesture ] [ drop ] if* ; swap window [ propagate-key-gesture ] [ drop ] if* ;
: interpret-key-event ( view event -- ) : interpret-key-event ( view event -- )
NSArray swap -> arrayWithObject: -> interpretKeyEvents: ; NSArray swap send\ arrayWithObject: send\ interpretKeyEvents: ;
: send-key-down-event ( view event -- ) : send-key-down-event ( view event -- )
[ key-event>gesture <key-down> send-key-event ] [ key-event>gesture <key-down> send-key-event ]
@ -109,7 +109,7 @@ CONSTANT: key-codes
[ send-button-up ] [ 2drop ] if* ; [ send-button-up ] [ 2drop ] if* ;
: send-scroll$ ( view event -- ) : send-scroll$ ( view event -- )
[ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ] [ nip [ send\ deltaX ] [ send\ deltaY ] bi [ neg ] bi@ 2array ]
[ mouse-location ] [ mouse-location ]
[ drop window ] [ drop window ]
2tri 2tri
@ -164,15 +164,15 @@ CLASS: FactorView < NSOpenGLView
COCOA-PROTOCOL: NSTextInput COCOA-PROTOCOL: NSTextInput
METHOD: void prepareOpenGL [ METHOD: void prepareOpenGL [
self SUPER-> prepareOpenGL self super-send\ prepareOpenGL
self SEL: setWantsBestResolutionOpenGLSurface: self sel\ setWantsBestResolutionOpenGLSurface:
-> respondsToSelector: c-bool> [ send\ respondsToSelector: c-bool> [
self SEL: setWantsBestResolutionOpenGLSurface: 1 self sel\ setWantsBestResolutionOpenGLSurface: 1
void f "objc_msgSend" { id SEL char } alien-invoke void f "objc_msgSend" { id SEL char } alien-invoke
self SEL: backingScaleFactor self sel\ backingScaleFactor
double f "objc_msgSend" { id SEL } alien-invoke double f "objc_msgSend" { id SEL } alien-invoke
dup 1.0 > [ dup 1.0 > [
@ -222,8 +222,8 @@ CLASS: FactorView < NSOpenGLView
METHOD: char validateUserInterfaceItem: id event METHOD: char validateUserInterfaceItem: id event
[ [
self window [ self window [
event -> action utf8 alien>string validate-action event send\ action utf8 alien>string validate-action
[ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if [ >c-bool ] [ drop self event super-send\ validateUserInterfaceItem: ] if
] [ 0 ] if* ] [ 0 ] if*
] ; ] ;
@ -255,7 +255,7 @@ CLASS: FactorView < NSOpenGLView
METHOD: void magnifyWithEvent: id event METHOD: void magnifyWithEvent: id event
[ [
self event self event
dup -> deltaZ sgn { dup send\ deltaZ sgn {
{ 1 [ zoom-in-action send-action$ ] } { 1 [ zoom-in-action send-action$ ] }
{ -1 [ zoom-out-action send-action$ ] } { -1 [ zoom-out-action send-action$ ] }
{ 0 [ 2drop ] } { 0 [ 2drop ] }
@ -265,12 +265,12 @@ CLASS: FactorView < NSOpenGLView
METHOD: void swipeWithEvent: id event METHOD: void swipeWithEvent: id event
[ [
self event self event
dup -> deltaX sgn { dup send\ deltaX sgn {
{ 1 [ left-action send-action$ ] } { 1 [ left-action send-action$ ] }
{ -1 [ right-action send-action$ ] } { -1 [ right-action send-action$ ] }
{ 0 { 0
[ [
dup -> deltaY sgn { dup send\ deltaY sgn {
{ 1 [ up-action send-action$ ] } { 1 [ up-action send-action$ ] }
{ -1 [ down-action send-action$ ] } { -1 [ down-action send-action$ ] }
{ 0 [ 2drop ] } { 0 [ 2drop ] }
@ -330,7 +330,7 @@ CLASS: FactorView < NSOpenGLView
METHOD: void unmarkText [ ] ; METHOD: void unmarkText [ ] ;
METHOD: id validAttributesForMarkedText [ NSArray -> array ] ; METHOD: id validAttributesForMarkedText [ NSArray send\ array ] ;
METHOD: id attributedSubstringFromRange: NSRange range [ f ] ; METHOD: id attributedSubstringFromRange: NSRange range [ f ] ;
@ -353,7 +353,7 @@ CLASS: FactorView < NSOpenGLView
METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
[ [
self frame pixelFormat SUPER-> initWithFrame:pixelFormat: self frame pixelFormat super-send\ initWithFrame:pixelFormat:
dup dup add-resize-observer dup dup add-resize-observer
] ; ] ;
@ -362,41 +362,41 @@ CLASS: FactorView < NSOpenGLView
METHOD: void dealloc METHOD: void dealloc
[ [
self remove-observer self remove-observer
self SUPER-> dealloc self super-send\ dealloc
] ; ] ;
; ;
: sync-refresh-to-screen ( GLView -- ) : sync-refresh-to-screen ( GLView -- )
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 int <ref> send\ openGLContext send\ CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
CGLSetParameter drop ; CGLSetParameter drop ;
: <FactorView> ( dim pixel-format -- view ) : <FactorView> ( dim pixel-format -- view )
[ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ; [ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ;
: save-position ( world window -- ) : save-position ( world window -- )
-> frame CGRect-top-left 2array >>window-loc drop ; send\ frame CGRect-top-left 2array >>window-loc drop ;
CLASS: FactorWindowDelegate < NSObject CLASS: FactorWindowDelegate < NSObject
METHOD: void windowDidMove: id notification METHOD: void windowDidMove: id notification
[ [
notification -> object -> contentView window notification send\ object send\ contentView window
[ notification -> object save-position ] when* [ notification send\ object save-position ] when*
] ; ] ;
METHOD: void windowDidBecomeKey: id notification METHOD: void windowDidBecomeKey: id notification
[ [
notification -> object -> contentView window notification send\ object send\ contentView window
[ focus-world ] when* [ focus-world ] when*
] ; ] ;
METHOD: void windowDidResignKey: id notification METHOD: void windowDidResignKey: id notification
[ [
forget-rollover forget-rollover
notification -> object -> contentView :> view notification send\ object send\ contentView :> view
view window :> window view window :> window
window [ window [
view -> isInFullScreenMode 0 = view send\ isInFullScreenMode 0 =
[ window unfocus-world ] when [ window unfocus-world ] when
] when ] when
] ; ] ;
@ -405,17 +405,17 @@ CLASS: FactorWindowDelegate < NSObject
METHOD: void windowWillClose: id notification METHOD: void windowWillClose: id notification
[ [
notification -> object -> contentView notification send\ object send\ contentView
[ window ungraft ] [ unregister-window ] bi [ window ungraft ] [ unregister-window ] bi
] ; ] ;
METHOD: void windowDidChangeBackingProperties: id notification METHOD: void windowDidChangeBackingProperties: id notification
[ [
notification -> object dup SEL: backingScaleFactor notification send\ object dup sel\ backingScaleFactor
-> respondsToSelector: c-bool> [ send\ respondsToSelector: c-bool> [
SEL: backingScaleFactor sel\ backingScaleFactor
double f "objc_msgSend" { id SEL } alien-invoke double f "objc_msgSend" { id SEL } alien-invoke
[ [ 1.0 > ] keep f ? gl-scale-factor set-global ] [ [ 1.0 > ] keep f ? gl-scale-factor set-global ]

View File

@ -15,9 +15,9 @@ os macosx? [
: <CGImage> ( byte-array -- image-rep ) : <CGImage> ( byte-array -- image-rep )
[ NSBitmapImageRep ] dip [ NSBitmapImageRep ] dip
<CFData> -> autorelease <CFData> send\ autorelease
-> imageRepWithData: send\ imageRepWithData:
-> CGImage ; send\ CGImage ;
:: CGImage>image ( image -- image ) :: CGImage>image ( image -- image )
image CGImageGetWidth :> w image CGImageGetWidth :> w
@ -29,7 +29,7 @@ os macosx? [
: image>CGImage ( image -- image ) : image>CGImage ( image -- image )
[ bitmap>> ] [ dim>> first2 ] bi 8 pick 4 * [ bitmap>> ] [ dim>> first2 ] bi 8 pick 4 *
bitmap-color-space bitmap-flags bitmap-color-space bitmap-flags
CGBitmapContextCreate -> autorelease CGBitmapContextCreate send\ autorelease
CGBitmapContextCreateImage ; CGBitmapContextCreateImage ;
M: ns-image stream>image* M: ns-image stream>image*

View File

@ -71,9 +71,9 @@ in: tools.deploy.macosx
deploy-name get ".app" append ; deploy-name get ".app" append ;
: show-in-finder ( path -- ) : show-in-finder ( path -- )
[ NSWorkspace -> sharedWorkspace ] [ NSWorkspace send\ sharedWorkspace ]
[ normalize-path [ <NSString> ] [ parent-directory <NSString> ] bi ] bi* [ normalize-path [ <NSString> ] [ parent-directory <NSString> ] bi ] bi*
-> selectFile:inFileViewerRootedAtPath: drop ; send\ selectFile:inFileViewerRootedAtPath: drop ;
: ?show-in-finder ( path -- ) : ?show-in-finder ( path -- )
open-directory-after-deploy? get [ show-in-finder ] [ drop ] if ; open-directory-after-deploy? get [ show-in-finder ] [ drop ] if ;

View File

@ -15,8 +15,8 @@ CLASS: Bar < NSObject
; ;
: main ( -- ) : main ( -- )
Bar -> alloc -> init Bar send\ alloc send\ init
S{ CGRect f S{ CGPoint f 1.0 2.0 } S{ CGSize f 3.0 4.0 } } -> bar: S{ CGRect f S{ CGPoint f 1.0 2.0 } S{ CGSize f 3.0 4.0 } } send\ bar:
10.0 assert= ; 10.0 assert= ;
main: main main: main