cocoa: Prefer ``send: foo`` or ``send: \foo:`` instead of ``send\ foo:``
Doug Coleman
parent
8d2d8f99e9
commit
5fb483099f
|
|
@ -7,9 +7,9 @@ multiline words ;
|
|||
IN: cocoa.apple-script
|
||||
|
||||
: run-apple-script ( str -- )
|
||||
[ NSAppleScript send\ alloc ] dip
|
||||
<NSString> send\ initWithSource: send\ autorelease
|
||||
f send\ executeAndReturnError: drop ;
|
||||
[ NSAppleScript send: alloc ] dip
|
||||
<NSString> send: \initWithSource: send: autorelease
|
||||
f send: \executeAndReturnError: drop ;
|
||||
|
||||
SYNTAX: \APPLESCRIPT:
|
||||
scan-new-word scan-object
|
||||
|
|
|
|||
|
|
@ -4,16 +4,16 @@ USING: alien.c-types alien.syntax cocoa cocoa.classes
|
|||
cocoa.runtime core-foundation.strings kernel sequences ;
|
||||
IN: cocoa.application
|
||||
|
||||
: <NSString> ( str -- alien ) <CFString> send\ autorelease ;
|
||||
: <NSString> ( str -- alien ) <CFString> send: autorelease ;
|
||||
|
||||
CONSTANT: NSApplicationDelegateReplySuccess 0
|
||||
CONSTANT: NSApplicationDelegateReplyCancel 1
|
||||
CONSTANT: NSApplicationDelegateReplyFailure 2
|
||||
|
||||
: with-autorelease-pool ( quot -- )
|
||||
NSAutoreleasePool send\ new [ call ] [ send\ release ] bi* ; inline
|
||||
NSAutoreleasePool send: new [ call ] [ send: release ] bi* ; inline
|
||||
|
||||
: NSApp ( -- app ) NSApplication send\ sharedApplication ;
|
||||
: NSApp ( -- app ) NSApplication send: sharedApplication ;
|
||||
|
||||
CONSTANT: NSAnyEventMask 0xffffffff
|
||||
|
||||
|
|
@ -24,24 +24,24 @@ FUNCTION: void NSBeep ( )
|
|||
|
||||
: add-observer ( observer selector name object -- )
|
||||
[
|
||||
[ NSNotificationCenter send\ defaultCenter ] 2dip
|
||||
[ NSNotificationCenter send: defaultCenter ] 2dip
|
||||
sel_registerName
|
||||
] 2dip send\ addObserver:selector:name:object: ;
|
||||
] 2dip send: \addObserver:selector:name:object: ;
|
||||
|
||||
: remove-observer ( observer -- )
|
||||
[ NSNotificationCenter send\ defaultCenter ] dip
|
||||
send\ removeObserver: ;
|
||||
[ NSNotificationCenter send: defaultCenter ] dip
|
||||
send: \removeObserver: ;
|
||||
|
||||
: cocoa-app ( quot -- )
|
||||
[ call NSApp send\ run ] with-cocoa ; inline
|
||||
[ call NSApp send: run ] with-cocoa ; inline
|
||||
|
||||
: install-delegate ( receiver delegate -- )
|
||||
send\ alloc send\ init send\ setDelegate: ;
|
||||
send: alloc send: init send: \setDelegate: ;
|
||||
|
||||
: running.app? ( -- ? )
|
||||
! Test if we're running a .app.
|
||||
".app"
|
||||
NSBundle send\ mainBundle send\ bundlePath CF>string
|
||||
NSBundle send: mainBundle send: bundlePath CF>string
|
||||
subseq? ;
|
||||
|
||||
: assert.app ( message -- )
|
||||
|
|
|
|||
|
|
@ -2,25 +2,25 @@ USING: cocoa.messages help.markup help.syntax strings
|
|||
alien core-foundation ;
|
||||
IN: cocoa
|
||||
|
||||
HELP: send\
|
||||
{ $syntax "-> selector" }
|
||||
HELP: \send:
|
||||
{ $syntax "send: selector" }
|
||||
{ $values { "selector" "an Objective C method name" } }
|
||||
{ $description "A sugared form of the following:" }
|
||||
{ $code "\"selector\" send" } ;
|
||||
|
||||
HELP: super\
|
||||
{ $syntax "-> selector" }
|
||||
HELP: \super:
|
||||
{ $syntax "super: selector" }
|
||||
{ $values { "selector" "an Objective C method name" } }
|
||||
{ $description "A sugared form of the following:" }
|
||||
{ $code "\"selector\" send-super" } ;
|
||||
|
||||
{ send super-send postpone: \send\ postpone: \super\ } related-words
|
||||
{ send super-send postpone: \send: postpone: \super: } related-words
|
||||
|
||||
HELP: \IMPORT:
|
||||
{ $syntax "IMPORT: name" }
|
||||
{ $description "Makes an Objective C class available for use." }
|
||||
{ $examples
|
||||
{ $code "IMPORT: QTMovie" "QTMovie \"My Movie.mov\" <NSString> f send\ movieWithFile:error:" }
|
||||
{ $code "IMPORT: QTMovie" "QTMovie \"My Movie.mov\" <NSString> f send: \\movieWithFile:error:" }
|
||||
} ;
|
||||
|
||||
ARTICLE: "objc-calling" "Calling Objective C code"
|
||||
|
|
@ -30,8 +30,8 @@ ARTICLE: "objc-calling" "Calling Objective C code"
|
|||
$nl
|
||||
"Messages can be sent to classes and instances using a pair of parsing words:"
|
||||
{ $subsections
|
||||
postpone: \send\
|
||||
postpone: \super\
|
||||
postpone: \send:
|
||||
postpone: \super:
|
||||
}
|
||||
"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
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ IN: cocoa.tests
|
|||
;CLASS>
|
||||
|
||||
: test-foo ( -- )
|
||||
Foo send\ alloc send\ init
|
||||
dup 1.0 2.0 101.0 102.0 <CGRect> send\ foo:
|
||||
send\ release ;
|
||||
Foo send: alloc send: init
|
||||
dup 1.0 2.0 101.0 102.0 <CGRect> send: \foo:
|
||||
send: release ;
|
||||
|
||||
{ } [ test-foo ] unit-test
|
||||
|
||||
|
|
@ -27,9 +27,9 @@ IN: cocoa.tests
|
|||
|
||||
{ } [
|
||||
Bar [
|
||||
send\ alloc send\ init
|
||||
dup send\ bar "x" set
|
||||
send\ release
|
||||
send: alloc send: init
|
||||
dup send: bar "x" set
|
||||
send: release
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
||||
|
|
@ -47,8 +47,8 @@ IN: cocoa.tests
|
|||
|
||||
{ 144 } [
|
||||
Bar [
|
||||
send\ alloc send\ init
|
||||
dup 12 send\ babb:
|
||||
swap send\ release
|
||||
send: alloc send: init
|
||||
dup 12 send: \babb:
|
||||
swap send: release
|
||||
] compile-call
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -12,12 +12,12 @@ SYMBOL: sent-messages
|
|||
: remember-send ( selector -- )
|
||||
sent-messages (remember-send) ;
|
||||
|
||||
SYNTAX: \send\ scan-token dup remember-send suffix! \ send suffix! ;
|
||||
SYNTAX: \send: scan-token unescape-token dup remember-send suffix! \ send suffix! ;
|
||||
|
||||
SYNTAX: \?send\ scan-token dup remember-send suffix! \ ?send suffix! ;
|
||||
SYNTAX: \?send: scan-token unescape-token dup remember-send suffix! \ ?send suffix! ;
|
||||
|
||||
SYNTAX: \selector\
|
||||
scan-token
|
||||
SYNTAX: \selector:
|
||||
scan-token unescape-token
|
||||
[ remember-send ]
|
||||
[ <selector> suffix! \ cocoa.messages:selector suffix! ] bi ;
|
||||
|
||||
|
|
@ -26,7 +26,7 @@ SYMBOL: super-sent-messages
|
|||
: remember-super-send ( selector -- )
|
||||
super-sent-messages (remember-send) ;
|
||||
|
||||
SYNTAX: \super\ scan-token dup remember-super-send suffix! \ super-send suffix! ;
|
||||
SYNTAX: \super: scan-token unescape-token dup remember-super-send suffix! \ super-send suffix! ;
|
||||
|
||||
SYMBOL: frameworks
|
||||
|
||||
|
|
|
|||
|
|
@ -5,27 +5,27 @@ core-foundation.strings kernel splitting ;
|
|||
IN: cocoa.dialogs
|
||||
|
||||
: <NSOpenPanel> ( -- panel )
|
||||
NSOpenPanel send\ openPanel
|
||||
dup 1 send\ setCanChooseFiles:
|
||||
dup 0 send\ setCanChooseDirectories:
|
||||
dup 1 send\ setResolvesAliases:
|
||||
dup 1 send\ setAllowsMultipleSelection: ;
|
||||
NSOpenPanel send: openPanel
|
||||
dup 1 send: \setCanChooseFiles:
|
||||
dup 0 send: \setCanChooseDirectories:
|
||||
dup 1 send: \setResolvesAliases:
|
||||
dup 1 send: \setAllowsMultipleSelection: ;
|
||||
|
||||
: <NSDirPanel> ( -- panel ) <NSOpenPanel>
|
||||
dup 1 send\ setCanChooseDirectories: ;
|
||||
dup 1 send: \setCanChooseDirectories: ;
|
||||
|
||||
: <NSSavePanel> ( -- panel )
|
||||
NSSavePanel send\ savePanel
|
||||
dup 1 send\ setCanChooseFiles:
|
||||
dup 0 send\ setCanChooseDirectories:
|
||||
dup 0 send\ setAllowsMultipleSelection: ;
|
||||
NSSavePanel send: savePanel
|
||||
dup 1 send: \setCanChooseFiles:
|
||||
dup 0 send: \setCanChooseDirectories:
|
||||
dup 0 send: \setAllowsMultipleSelection: ;
|
||||
|
||||
CONSTANT: NSOKButton 1
|
||||
CONSTANT: NSCancelButton 0
|
||||
|
||||
: (open-panel) ( panel -- paths )
|
||||
dup send\ runModal NSOKButton =
|
||||
[ send\ filenames CF>string-array ] [ drop f ] if ;
|
||||
dup send: runModal NSOKButton =
|
||||
[ send: filenames CF>string-array ] [ drop f ] if ;
|
||||
|
||||
: open-panel ( -- paths ) <NSOpenPanel> (open-panel) ;
|
||||
|
||||
|
|
@ -36,5 +36,5 @@ CONSTANT: NSCancelButton 0
|
|||
|
||||
: save-panel ( path -- path/f )
|
||||
[ <NSSavePanel> dup ] dip
|
||||
split-path send\ runModalForDirectory:file: NSOKButton =
|
||||
[ send\ filename CF>string ] [ drop f ] if ;
|
||||
split-path send: \runModalForDirectory:file: NSOKButton =
|
||||
[ send: filename CF>string ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ CONSTANT: NS-EACH-BUFFER-SIZE 16
|
|||
] with-destructors ; inline
|
||||
|
||||
:: (NSFastEnumeration-each) ( ... object quot: ( ... elt -- ) state stackbuf count -- ... )
|
||||
object state stackbuf count send\ countByEnumeratingWithState:objects:count: :> items-count
|
||||
object state stackbuf count send: \countByEnumeratingWithState:objects:count: :> items-count
|
||||
items-count 0 = [
|
||||
state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
|
||||
items-count <iota> [ items nth quot call ] each
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ HELP: super-send
|
|||
HELP: objc-class
|
||||
{ $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:"
|
||||
{ $code "NSMutableArray send\ alloc" } }
|
||||
{ $code "NSMutableArray send: alloc" } }
|
||||
{ $errors "Throws an error if there is no class named by " { $snippet "string" } "." } ;
|
||||
|
||||
HELP: objc-meta-class
|
||||
|
|
|
|||
|
|
@ -6,15 +6,15 @@ IN: cocoa.nibs
|
|||
|
||||
: load-nib ( name -- )
|
||||
NSBundle
|
||||
swap <NSString> NSApp send\ loadNibNamed:owner:
|
||||
swap <NSString> NSApp send: \loadNibNamed:owner:
|
||||
drop ;
|
||||
|
||||
: nib-named ( nib-name -- anNSNib )
|
||||
<NSString> NSNib send\ alloc swap f send\ initWithNibNamed:bundle:
|
||||
dup [ send\ autorelease ] when ;
|
||||
<NSString> NSNib send: alloc swap f send: \initWithNibNamed:bundle:
|
||||
dup [ send: autorelease ] when ;
|
||||
|
||||
: nib-objects ( anNSNib -- objects/f )
|
||||
f
|
||||
{ void* } [ send\ instantiateNibWithOwner:topLevelObjects: ]
|
||||
{ void* } [ send: \instantiateNibWithOwner:topLevelObjects: ]
|
||||
with-out-parameters
|
||||
swap [ CF>array ] [ drop f ] if ;
|
||||
|
|
|
|||
|
|
@ -8,19 +8,19 @@ IN: cocoa.pasteboard
|
|||
CONSTANT: NSStringPboardType "NSStringPboardType"
|
||||
|
||||
: pasteboard-string? ( pasteboard -- ? )
|
||||
NSStringPboardType swap send\ types CF>string-array member? ;
|
||||
NSStringPboardType swap send: types CF>string-array member? ;
|
||||
|
||||
: pasteboard-string ( pasteboard -- str )
|
||||
NSStringPboardType <NSString> send\ stringForType:
|
||||
NSStringPboardType <NSString> send: \stringForType:
|
||||
dup [ CF>string ] when ;
|
||||
|
||||
: set-pasteboard-types ( seq pasteboard -- )
|
||||
swap <CFArray> send\ autorelease f send\ declareTypes:owner: drop ;
|
||||
swap <CFArray> send: autorelease f send: \declareTypes:owner: drop ;
|
||||
|
||||
: set-pasteboard-string ( str pasteboard -- )
|
||||
NSStringPboardType <NSString>
|
||||
dup 1array pick set-pasteboard-types
|
||||
[ swap <NSString> ] dip send\ setString:forType: drop ;
|
||||
[ swap <NSString> ] dip send: \setString:forType: drop ;
|
||||
|
||||
: pasteboard-error ( error -- f )
|
||||
"Pasteboard does not hold a string" <NSString>
|
||||
|
|
|
|||
|
|
@ -8,10 +8,10 @@ core-foundation.utilities fry io.backend kernel macros math
|
|||
quotations sequences ;
|
||||
IN: cocoa.plists
|
||||
|
||||
: >plist ( value -- plist ) >cf send\ autorelease ;
|
||||
: >plist ( value -- plist ) >cf send: autorelease ;
|
||||
|
||||
: write-plist ( assoc path -- )
|
||||
[ >plist ] [ normalize-path <NSString> ] bi* 0 send\ writeToFile:atomically:
|
||||
[ >plist ] [ normalize-path <NSString> ] bi* 0 send: \writeToFile:atomically:
|
||||
[ "write-plist failed" throw ] unless ;
|
||||
|
||||
DEFER: plist>
|
||||
|
|
@ -19,30 +19,30 @@ DEFER: plist>
|
|||
<PRIVATE
|
||||
|
||||
: (plist-NSNumber>) ( NSNumber -- number )
|
||||
dup send\ doubleValue dup >integer =
|
||||
[ send\ longLongValue ] [ send\ doubleValue ] if ;
|
||||
dup send: doubleValue dup >integer =
|
||||
[ send: longLongValue ] [ send: doubleValue ] if ;
|
||||
|
||||
: (plist-NSData>) ( NSData -- byte-array )
|
||||
dup send\ length <byte-array> [ send\ getBytes: ] keep ;
|
||||
dup send: length <byte-array> [ send: \getBytes: ] keep ;
|
||||
|
||||
: (plist-NSArray>) ( NSArray -- vector )
|
||||
[ plist> ] NSFastEnumeration-map ;
|
||||
|
||||
: (plist-NSDictionary>) ( NSDictionary -- hashtable )
|
||||
dup [ [ nip ] [ send\ valueForKey: ] 2bi [ plist> ] bi@ ] with
|
||||
dup [ [ nip ] [ send: \valueForKey: ] 2bi [ plist> ] bi@ ] with
|
||||
NSFastEnumeration>hashtable ;
|
||||
|
||||
: (read-plist) ( NSData -- id )
|
||||
NSPropertyListSerialization swap kCFPropertyListImmutable f
|
||||
{ void* }
|
||||
[ send\ propertyListFromData:mutabilityOption:format:errorDescription: ]
|
||||
[ send: \propertyListFromData:mutabilityOption:format:errorDescription: ]
|
||||
with-out-parameters
|
||||
[ send\ release "read-plist failed" throw ] when* ;
|
||||
[ send: release "read-plist failed" throw ] when* ;
|
||||
|
||||
MACRO: objc-class-case ( alist -- quot )
|
||||
[
|
||||
dup callable?
|
||||
[ first2 [ '[ dup _ execute send\ isKindOfClass: c-bool> ] ] dip 2array ]
|
||||
[ first2 [ '[ dup _ execute send: \isKindOfClass: c-bool> ] ] dip 2array ]
|
||||
unless
|
||||
] map '[ _ cond ] ;
|
||||
|
||||
|
|
@ -63,5 +63,5 @@ ERROR: invalid-plist-object object ;
|
|||
|
||||
: read-plist ( path -- assoc )
|
||||
normalize-path <NSString>
|
||||
NSData swap send\ dataWithContentsOfFile:
|
||||
NSData swap send: \dataWithContentsOfFile:
|
||||
[ (read-plist) plist> ] [ "read-plist failed" throw ] if* ;
|
||||
|
|
|
|||
|
|
@ -10,22 +10,22 @@ ENUM: default-touchbar refresh-all-action auto-use-action ;
|
|||
|
||||
: enum>CFStringArray ( seq -- alien )
|
||||
enum>keys
|
||||
NSArray send\ alloc
|
||||
swap <CFStringArray> send\ initWithArray: ;
|
||||
NSArray send: alloc
|
||||
swap <CFStringArray> send: \initWithArray: ;
|
||||
|
||||
: make-touchbar ( enum self -- touchbar )
|
||||
[ NSTouchBar send\ alloc send\ init dup ] dip send\ setDelegate: {
|
||||
[ swap enum>CFStringArray { void { id SEL id } } ?send\ setDefaultItemIdentifiers: ]
|
||||
[ swap enum>CFStringArray { void { id SEL id } } ?send\ setCustomizationAllowedItemIdentifiers: ]
|
||||
[ NSTouchBar send: alloc send: init dup ] dip send: \setDelegate: {
|
||||
[ swap enum>CFStringArray { void { id SEL id } } ?send: \setDefaultItemIdentifiers: ]
|
||||
[ swap enum>CFStringArray { void { id SEL id } } ?send: \setCustomizationAllowedItemIdentifiers: ]
|
||||
[ nip ]
|
||||
} 2cleave ;
|
||||
|
||||
:: make-NSTouchBar-button ( self identifier label-string action-string -- button )
|
||||
NSCustomTouchBarItem send\ alloc
|
||||
identifier <CFString> { id { id SEL id } } ?send\ initWithIdentifier: :> item
|
||||
NSCustomTouchBarItem send: alloc
|
||||
identifier <CFString> { id { id SEL id } } ?send: \initWithIdentifier: :> item
|
||||
NSButton
|
||||
label-string <CFString>
|
||||
self
|
||||
action-string lookup-selector { id { id SEL id id SEL } } ?send\ buttonWithTitle:target:action: :> button
|
||||
item button send\ setView:
|
||||
action-string lookup-selector { id { id SEL id id SEL } } ?send: \buttonWithTitle:target:action: :> button
|
||||
item button send: \setView:
|
||||
item ;
|
||||
|
|
|
|||
|
|
@ -59,21 +59,21 @@ CONSTANT: NSOpenGLProfileVersion3_2Core 0x3200
|
|||
CONSTANT: NSOpenGLProfileVersion4_1Core 0x4100
|
||||
|
||||
: <GLView> ( class dim pixel-format -- view )
|
||||
[ send\ alloc ]
|
||||
[ send: alloc ]
|
||||
[ [ 0 0 ] dip first2 <CGRect> ]
|
||||
[ handle>> ] tri*
|
||||
send\ initWithFrame:pixelFormat:
|
||||
dup 1 send\ setPostsBoundsChangedNotifications:
|
||||
dup 1 send\ setPostsFrameChangedNotifications: ;
|
||||
send: \initWithFrame:pixelFormat:
|
||||
dup 1 send: \setPostsBoundsChangedNotifications:
|
||||
dup 1 send: \setPostsFrameChangedNotifications: ;
|
||||
|
||||
: view-dim ( view -- dim )
|
||||
send\ bounds
|
||||
send: bounds
|
||||
[ CGRect-w >fixnum ] [ CGRect-h >fixnum ] bi
|
||||
2array ;
|
||||
|
||||
: mouse-location ( view event -- loc )
|
||||
[
|
||||
send\ locationInWindow f send\ convertPoint:fromView:
|
||||
send: locationInWindow f send: \convertPoint:fromView:
|
||||
[ x>> ] [ y>> ] bi
|
||||
] [ drop send\ frame CGRect-h ] 2bi
|
||||
] [ drop send: frame CGRect-h ] 2bi
|
||||
swap - [ >integer ] bi@ 2array ;
|
||||
|
|
|
|||
|
|
@ -22,19 +22,19 @@ CONSTANT: NSBackingStoreNonretained 1
|
|||
CONSTANT: NSBackingStoreBuffered 2
|
||||
|
||||
: <NSWindow> ( rect style class -- window )
|
||||
[ send\ alloc ] curry 2dip NSBackingStoreBuffered 1
|
||||
send\ initWithContentRect:styleMask:backing:defer: ;
|
||||
[ send: alloc ] curry 2dip NSBackingStoreBuffered 1
|
||||
send: \initWithContentRect:styleMask:backing:defer: ;
|
||||
|
||||
: class-for-style ( style -- NSWindow/NSPanel )
|
||||
0x1ef0 bitand zero? NSWindow NSPanel ? ;
|
||||
|
||||
: <ViewWindow> ( view rect style -- window )
|
||||
dup class-for-style <NSWindow> [ swap send\ setContentView: ] keep
|
||||
dup dup send\ contentView send\ setInitialFirstResponder:
|
||||
dup 1 send\ setAcceptsMouseMovedEvents:
|
||||
dup 0 send\ setReleasedWhenClosed: ;
|
||||
dup class-for-style <NSWindow> [ swap send: \setContentView: ] keep
|
||||
dup dup send: contentView send: \setInitialFirstResponder:
|
||||
dup 1 send: \setAcceptsMouseMovedEvents:
|
||||
dup 0 send: \setReleasedWhenClosed: ;
|
||||
|
||||
: window-content-rect ( window -- rect )
|
||||
dup send\ class swap
|
||||
[ send\ frame ] [ send\ styleMask ] bi
|
||||
send\ contentRectForFrameRect:styleMask: ;
|
||||
dup send: class swap
|
||||
[ send: frame ] [ send: styleMask ] bi
|
||||
send: \contentRectForFrameRect:styleMask: ;
|
||||
|
|
|
|||
|
|
@ -15,9 +15,9 @@ os macosx? [
|
|||
|
||||
: <CGImage> ( byte-array -- image-rep )
|
||||
[ NSBitmapImageRep ] dip
|
||||
<CFData> send\ autorelease
|
||||
send\ imageRepWithData:
|
||||
send\ CGImage ;
|
||||
<CFData> send: autorelease
|
||||
send: \imageRepWithData:
|
||||
send: CGImage ;
|
||||
|
||||
:: CGImage>image ( image -- image )
|
||||
image CGImageGetWidth :> w
|
||||
|
|
@ -29,7 +29,7 @@ os macosx? [
|
|||
: image>CGImage ( image -- image )
|
||||
[ bitmap>> ] [ dim>> first2 ] bi 8 pick 4 *
|
||||
bitmap-color-space bitmap-flags
|
||||
CGBitmapContextCreate send\ autorelease
|
||||
CGBitmapContextCreate send: autorelease
|
||||
CGBitmapContextCreateImage ;
|
||||
|
||||
M: ns-image stream>image*
|
||||
|
|
|
|||
|
|
@ -15,8 +15,8 @@ IN: tools.deploy.test.14
|
|||
;CLASS>
|
||||
|
||||
: main ( -- )
|
||||
Bar send\ alloc send\ init
|
||||
S{ CGRect f S{ CGPoint f 1.0 2.0 } S{ CGSize f 3.0 4.0 } } send\ bar:
|
||||
Bar send: alloc send: init
|
||||
S{ CGRect f S{ CGPoint f 1.0 2.0 } S{ CGSize f 3.0 4.0 } } send: \bar:
|
||||
10.0 assert= ;
|
||||
|
||||
MAIN: main
|
||||
|
|
|
|||
|
|
@ -47,10 +47,10 @@ CONSTANT: attrib-table H{
|
|||
|
||||
M: cocoa-ui-backend (make-pixel-format)
|
||||
nip { } attrib-table pixel-format-attributes>int-array
|
||||
NSOpenGLPixelFormat send\ alloc swap send\ initWithAttributes: ;
|
||||
NSOpenGLPixelFormat send: alloc swap send: \initWithAttributes: ;
|
||||
|
||||
M: cocoa-ui-backend (free-pixel-format)
|
||||
handle>> send\ release ;
|
||||
handle>> send: release ;
|
||||
|
||||
TUPLE: pasteboard handle ;
|
||||
|
||||
|
|
@ -63,7 +63,7 @@ M: pasteboard set-clipboard-contents
|
|||
handle>> set-pasteboard-string ;
|
||||
|
||||
: init-clipboard ( -- )
|
||||
NSPasteboard send\ generalPasteboard <pasteboard>
|
||||
NSPasteboard send: generalPasteboard <pasteboard>
|
||||
clipboard set-global
|
||||
<clipboard> selection set-global ;
|
||||
|
||||
|
|
@ -76,32 +76,32 @@ M: pasteboard set-clipboard-contents
|
|||
! after register-window.
|
||||
dup { 0 0 } = [
|
||||
drop
|
||||
ui-windows get-global length 1 <= [ send\ center ] [
|
||||
ui-windows get-global length 1 <= [ send: center ] [
|
||||
ui-windows get-global last second window-loc>>
|
||||
dupd first2 <CGPoint> send\ cascadeTopLeftFromPoint:
|
||||
send\ setFrameTopLeftPoint:
|
||||
dupd first2 <CGPoint> send: \cascadeTopLeftFromPoint:
|
||||
send: \setFrameTopLeftPoint:
|
||||
] if
|
||||
] [ first2 <CGPoint> send\ setFrameTopLeftPoint: ] if ;
|
||||
] [ first2 <CGPoint> send: \setFrameTopLeftPoint: ] if ;
|
||||
|
||||
M: cocoa-ui-backend set-title ( string world -- )
|
||||
handle>> window>> swap <NSString> send\ setTitle: ;
|
||||
handle>> window>> swap <NSString> send: \setTitle: ;
|
||||
|
||||
: enter-fullscreen ( world -- )
|
||||
handle>> view>>
|
||||
NSScreen send\ mainScreen
|
||||
f send\ enterFullScreenMode:withOptions:
|
||||
NSScreen send: mainScreen
|
||||
f send: \enterFullScreenMode:withOptions:
|
||||
drop ;
|
||||
|
||||
: exit-fullscreen ( world -- )
|
||||
handle>>
|
||||
[ view>> f send\ exitFullScreenModeWithOptions: ]
|
||||
[ [ window>> ] [ view>> ] bi send\ makeFirstResponder: drop ] bi ;
|
||||
[ view>> f send: \exitFullScreenModeWithOptions: ]
|
||||
[ [ window>> ] [ view>> ] bi send: \makeFirstResponder: drop ] bi ;
|
||||
|
||||
M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
|
||||
[ enter-fullscreen ] [ exit-fullscreen ] if ;
|
||||
|
||||
M: cocoa-ui-backend (fullscreen?) ( world -- ? )
|
||||
handle>> view>> send\ isInFullScreenMode zero? not ;
|
||||
handle>> view>> send: isInFullScreenMode zero? not ;
|
||||
|
||||
! XXX: Until someone tests OSX with a tiling window manager,
|
||||
! dialog-window is the same as normal-title-window
|
||||
|
|
@ -121,8 +121,8 @@ CONSTANT: window-control>styleMask
|
|||
window-controls>> window-control>styleMask symbols>flags ;
|
||||
|
||||
: make-context-transparent ( view -- )
|
||||
send\ openGLContext
|
||||
0 int <ref> NSOpenGLCPSurfaceOpacity send\ setValues:forParameter: ;
|
||||
send: openGLContext
|
||||
0 int <ref> NSOpenGLCPSurfaceOpacity send: \setValues:forParameter: ;
|
||||
|
||||
M:: cocoa-ui-backend (open-window) ( world -- )
|
||||
world [ [ dim>> ] dip <FactorView> ]
|
||||
|
|
@ -130,27 +130,27 @@ M:: cocoa-ui-backend (open-window) ( world -- )
|
|||
world window-controls>> textured-background swap member-eq?
|
||||
[ view make-context-transparent ] when
|
||||
view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
|
||||
view send\ release
|
||||
view send: release
|
||||
world view register-window
|
||||
window world window-loc>> auto-position
|
||||
world window save-position
|
||||
window install-window-delegate
|
||||
view window <window-handle> world handle<<
|
||||
window f send\ makeKeyAndOrderFront:
|
||||
window f send: \makeKeyAndOrderFront:
|
||||
t world active?<< ;
|
||||
|
||||
M: cocoa-ui-backend (close-window) ( handle -- )
|
||||
[
|
||||
view>> dup send\ isInFullScreenMode zero?
|
||||
view>> dup send: isInFullScreenMode zero?
|
||||
[ drop ]
|
||||
[ f send\ exitFullScreenModeWithOptions: ] if
|
||||
] [ window>> send\ release ] bi ;
|
||||
[ f send: \exitFullScreenModeWithOptions: ] if
|
||||
] [ window>> send: release ] bi ;
|
||||
|
||||
M: cocoa-ui-backend (grab-input) ( handle -- )
|
||||
0 CGAssociateMouseAndMouseCursorPosition drop
|
||||
CGMainDisplayID CGDisplayHideCursor drop
|
||||
window>> send\ frame CGRect>rect rect-center
|
||||
NSScreen send\ screens 0 send\ objectAtIndex: send\ frame CGRect-h
|
||||
window>> send: frame CGRect>rect rect-center
|
||||
NSScreen send: screens 0 send: \objectAtIndex: send: frame CGRect-h
|
||||
[ drop first ] [ swap second - ] 2bi <CGPoint>
|
||||
[ GetCurrentButtonState zero? not ] [ yield ] while
|
||||
CGWarpMouseCursorPosition drop ;
|
||||
|
|
@ -163,35 +163,35 @@ M: cocoa-ui-backend (ungrab-input) ( handle -- )
|
|||
M: cocoa-ui-backend close-window ( gadget -- )
|
||||
find-world [
|
||||
handle>> [
|
||||
window>> send\ close
|
||||
window>> send: close
|
||||
] when*
|
||||
] when* ;
|
||||
|
||||
M: cocoa-ui-backend raise-window* ( world -- )
|
||||
handle>> [
|
||||
window>> dup f send\ orderFront: send\ makeKeyWindow
|
||||
NSApp 1 send\ activateIgnoringOtherApps:
|
||||
window>> dup f send: \orderFront: send: makeKeyWindow
|
||||
NSApp 1 send: \activateIgnoringOtherApps:
|
||||
] when* ;
|
||||
|
||||
M: window-handle select-gl-context ( handle -- )
|
||||
view>> send\ openGLContext send\ makeCurrentContext ;
|
||||
view>> send: openGLContext send: makeCurrentContext ;
|
||||
|
||||
M: window-handle flush-gl-context ( handle -- )
|
||||
view>> send\ openGLContext send\ flushBuffer ;
|
||||
view>> send: openGLContext send: flushBuffer ;
|
||||
|
||||
M: cocoa-ui-backend beep ( -- )
|
||||
NSBeep ;
|
||||
|
||||
M: cocoa-ui-backend resize-window
|
||||
[ handle>> window>> ] [ first2 ] bi* <CGSize> send\ setContentSize: ;
|
||||
[ handle>> window>> ] [ first2 ] bi* <CGSize> send: \setContentSize: ;
|
||||
|
||||
M: cocoa-ui-backend system-alert
|
||||
NSAlert send\ alloc send\ init send\ autorelease [
|
||||
NSAlert send: alloc send: init send: autorelease [
|
||||
{
|
||||
[ swap <NSString> send\ setInformativeText: ]
|
||||
[ swap <NSString> send\ setMessageText: ]
|
||||
[ "OK" <NSString> send\ addButtonWithTitle: drop ]
|
||||
[ send\ runModal drop ]
|
||||
[ swap <NSString> send: \setInformativeText: ]
|
||||
[ swap <NSString> send: \setMessageText: ]
|
||||
[ "OK" <NSString> send: \addButtonWithTitle: drop ]
|
||||
[ send: runModal drop ]
|
||||
} cleave
|
||||
] [ 2drop ] if* ;
|
||||
|
||||
|
|
@ -222,7 +222,7 @@ M: cocoa-ui-backend (with-ui)
|
|||
stop-io-thread
|
||||
init-thread-timer
|
||||
reset-thread-timer
|
||||
NSApp send\ run
|
||||
NSApp send: run
|
||||
] ui-running
|
||||
] with-cocoa ;
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ IN: ui.backend.cocoa.tools
|
|||
: finder-run-files ( alien -- )
|
||||
CF>string-array listener-run-files
|
||||
NSApp NSApplicationDelegateReplySuccess
|
||||
send\ replyToOpenOrPrint: ;
|
||||
send: \replyToOpenOrPrint: ;
|
||||
|
||||
: menu-run-files ( -- )
|
||||
open-panel [ listener-run-files ] when* ;
|
||||
|
|
@ -71,8 +71,8 @@ IN: ui.backend.cocoa.tools
|
|||
|
||||
: register-services ( -- )
|
||||
NSApp
|
||||
FactorServiceProvider send\ alloc send\ init
|
||||
send\ setServicesProvider: ;
|
||||
FactorServiceProvider send: alloc send: init
|
||||
send: \setServicesProvider: ;
|
||||
|
||||
FUNCTION: void NSUpdateDynamicServices ( )
|
||||
|
||||
|
|
|
|||
|
|
@ -17,8 +17,8 @@ IN: ui.backend.cocoa.views
|
|||
|
||||
! Issue #1453
|
||||
: button ( event -- n )
|
||||
! Cocoa send\ Factor UI button mapping
|
||||
send\ buttonNumber {
|
||||
! Cocoa send: Factor UI button mapping
|
||||
send: buttonNumber {
|
||||
{ 0 [ 1 ] }
|
||||
{ 1 [ 3 ] }
|
||||
{ 2 [ 2 ] }
|
||||
|
|
@ -69,11 +69,11 @@ CONSTANT: key-codes
|
|||
}
|
||||
|
||||
: key-code ( event -- string ? )
|
||||
dup send\ keyCode key-codes at
|
||||
[ t ] [ send\ charactersIgnoringModifiers CF>string f ] ?if ;
|
||||
dup send: keyCode key-codes at
|
||||
[ t ] [ send: charactersIgnoringModifiers CF>string f ] ?if ;
|
||||
|
||||
: event-modifiers ( event -- modifiers )
|
||||
send\ modifierFlags modifiers modifier ;
|
||||
send: modifierFlags modifiers modifier ;
|
||||
|
||||
: key-event>gesture ( event -- modifiers keycode action? )
|
||||
[ event-modifiers ] [ key-code ] bi ;
|
||||
|
|
@ -82,7 +82,7 @@ CONSTANT: key-codes
|
|||
swap window [ propagate-key-gesture ] [ drop ] if* ;
|
||||
|
||||
: interpret-key-event ( view event -- )
|
||||
NSArray swap send\ arrayWithObject: send\ interpretKeyEvents: ;
|
||||
NSArray swap send: \arrayWithObject: send: \interpretKeyEvents: ;
|
||||
|
||||
: send-key-down-event ( view event -- )
|
||||
[ key-event>gesture <key-down> send-key-event ]
|
||||
|
|
@ -110,7 +110,7 @@ CONSTANT: key-codes
|
|||
[ send-button-up ] [ 2drop ] if* ;
|
||||
|
||||
: send-scroll$ ( view event -- )
|
||||
[ nip [ send\ deltaX ] [ send\ deltaY ] bi [ neg ] bi@ 2array ]
|
||||
[ nip [ send: deltaX ] [ send: deltaY ] bi [ neg ] bi@ 2array ]
|
||||
[ mouse-location ]
|
||||
[ drop window ]
|
||||
2tri
|
||||
|
|
@ -166,13 +166,13 @@ CONSTANT: selector>action H{
|
|||
|
||||
METHOD: void prepareOpenGL [
|
||||
|
||||
self selector\ setWantsBestResolutionOpenGLSurface:
|
||||
send\ respondsToSelector: c-bool> [
|
||||
self selector: \setWantsBestResolutionOpenGLSurface:
|
||||
send: \respondsToSelector: c-bool> [
|
||||
|
||||
self selector\ setWantsBestResolutionOpenGLSurface: 1
|
||||
self selector: \setWantsBestResolutionOpenGLSurface: 1
|
||||
void f "objc_msgSend" { id SEL char } f alien-invoke
|
||||
|
||||
self selector\ backingScaleFactor
|
||||
self selector: backingScaleFactor
|
||||
double f "objc_msgSend" { id SEL } f alien-invoke
|
||||
|
||||
dup 1.0 > [
|
||||
|
|
@ -245,8 +245,8 @@ CONSTANT: selector>action H{
|
|||
METHOD: char validateUserInterfaceItem: id event
|
||||
[
|
||||
self window [
|
||||
event send\ action utf8 alien>string validate-action
|
||||
[ >c-bool ] [ drop self event super\ validateUserInterfaceItem: ] if
|
||||
event send: action utf8 alien>string validate-action
|
||||
[ >c-bool ] [ drop self event super: \validateUserInterfaceItem: ] if
|
||||
] [ 0 ] if*
|
||||
] ;
|
||||
|
||||
|
|
@ -278,7 +278,7 @@ CONSTANT: selector>action H{
|
|||
METHOD: void magnifyWithEvent: id event
|
||||
[
|
||||
self event
|
||||
dup send\ deltaZ sgn {
|
||||
dup send: deltaZ sgn {
|
||||
{ 1 [ zoom-in-action send-action$ ] }
|
||||
{ -1 [ zoom-out-action send-action$ ] }
|
||||
{ 0 [ 2drop ] }
|
||||
|
|
@ -288,12 +288,12 @@ CONSTANT: selector>action H{
|
|||
METHOD: void swipeWithEvent: id event
|
||||
[
|
||||
self event
|
||||
dup send\ deltaX sgn {
|
||||
dup send: deltaX sgn {
|
||||
{ 1 [ left-action send-action$ ] }
|
||||
{ -1 [ right-action send-action$ ] }
|
||||
{ 0
|
||||
[
|
||||
dup send\ deltaY sgn {
|
||||
dup send: deltaY sgn {
|
||||
{ 1 [ up-action send-action$ ] }
|
||||
{ -1 [ down-action send-action$ ] }
|
||||
{ 0 [ 2drop ] }
|
||||
|
|
@ -353,7 +353,7 @@ CONSTANT: selector>action H{
|
|||
|
||||
METHOD: void unmarkText [ ] ;
|
||||
|
||||
METHOD: id validAttributesForMarkedText [ NSArray send\ array ] ;
|
||||
METHOD: id validAttributesForMarkedText [ NSArray send: array ] ;
|
||||
|
||||
METHOD: id attributedSubstringFromRange: NSRange range [ f ] ;
|
||||
|
||||
|
|
@ -376,7 +376,7 @@ CONSTANT: selector>action H{
|
|||
|
||||
METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat
|
||||
[
|
||||
self frame pixelFormat super\ initWithFrame:pixelFormat:
|
||||
self frame pixelFormat super: \initWithFrame:pixelFormat:
|
||||
dup dup add-resize-observer
|
||||
] ;
|
||||
|
||||
|
|
@ -385,41 +385,41 @@ CONSTANT: selector>action H{
|
|||
METHOD: void dealloc
|
||||
[
|
||||
self remove-observer
|
||||
self super\ dealloc
|
||||
self super: dealloc
|
||||
] ;
|
||||
;CLASS>
|
||||
|
||||
: sync-refresh-to-screen ( GLView -- )
|
||||
send\ openGLContext send\ CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
|
||||
send: openGLContext send: CGLContextObj NSOpenGLCPSwapInterval 1 int <ref>
|
||||
CGLSetParameter drop ;
|
||||
|
||||
: <FactorView> ( dim pixel-format -- view )
|
||||
[ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ;
|
||||
|
||||
: save-position ( world window -- )
|
||||
send\ frame CGRect-top-left 2array >>window-loc drop ;
|
||||
send: frame CGRect-top-left 2array >>window-loc drop ;
|
||||
|
||||
<CLASS: FactorWindowDelegate < NSObject
|
||||
|
||||
METHOD: void windowDidMove: id notification
|
||||
[
|
||||
notification send\ object send\ contentView window
|
||||
[ notification send\ object save-position ] when*
|
||||
notification send: object send: contentView window
|
||||
[ notification send: object save-position ] when*
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidBecomeKey: id notification
|
||||
[
|
||||
notification send\ object send\ contentView window
|
||||
notification send: object send: contentView window
|
||||
[ focus-world ] when*
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidResignKey: id notification
|
||||
[
|
||||
forget-rollover
|
||||
notification send\ object send\ contentView :> view
|
||||
notification send: object send: contentView :> view
|
||||
view window :> window
|
||||
window [
|
||||
view send\ isInFullScreenMode 0 =
|
||||
view send: isInFullScreenMode 0 =
|
||||
[ window unfocus-world ] when
|
||||
] when
|
||||
] ;
|
||||
|
|
@ -428,16 +428,16 @@ CONSTANT: selector>action H{
|
|||
|
||||
METHOD: void windowWillClose: id notification
|
||||
[
|
||||
notification send\ object send\ contentView
|
||||
notification send: object send: contentView
|
||||
[ window ungraft ] [ unregister-window ] bi
|
||||
] ;
|
||||
|
||||
METHOD: void windowDidChangeBackingProperties: id notification
|
||||
[
|
||||
|
||||
notification send\ object dup selector\ backingScaleFactor
|
||||
send\ respondsToSelector: c-bool> [
|
||||
{ double { id SEL } } ?send\ backingScaleFactor
|
||||
notification send: object dup selector: backingScaleFactor
|
||||
send: \respondsToSelector: c-bool> [
|
||||
{ double { id SEL } } ?send: backingScaleFactor
|
||||
|
||||
[ [ 1.0 > ] keep f ? gl-scale-factor set-global ]
|
||||
[ 1.0 > retina? set-global ] bi
|
||||
|
|
|
|||
|
|
@ -77,18 +77,18 @@ IMPORT: QTSampleBuffer
|
|||
IMPORT: QTTrack
|
||||
|
||||
: <movie> ( filename -- movie )
|
||||
QTMovie swap <NSString> f send\ movieWithFile:error: send\ retain ;
|
||||
QTMovie swap <NSString> f send: \movieWithFile:error: send: retain ;
|
||||
|
||||
: movie-attributes ( movie -- attributes )
|
||||
send\ movieAttributes plist> ;
|
||||
send: movieAttributes plist> ;
|
||||
|
||||
: play ( movie -- )
|
||||
send\ play ;
|
||||
send: play ;
|
||||
: stop ( movie -- )
|
||||
send\ stop ;
|
||||
send: stop ;
|
||||
|
||||
: movie-tracks ( movie -- tracks )
|
||||
send\ tracks NSFastEnumeration>vector ;
|
||||
send: tracks NSFastEnumeration>vector ;
|
||||
|
||||
: track-attributes ( track -- attributes )
|
||||
send\ trackAttributes plist> ;
|
||||
send: trackAttributes plist> ;
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@ IMPORT: WebView
|
|||
: rect ( -- rect ) 0 0 700 500 <CGRect> ;
|
||||
|
||||
: <WebView> ( -- id )
|
||||
WebView send\ alloc
|
||||
rect f f send\ initWithFrame:frameName:groupName: ;
|
||||
WebView send: alloc
|
||||
rect f f send: \initWithFrame:frameName:groupName: ;
|
||||
|
||||
CONSTANT: window-style
|
||||
flags{
|
||||
|
|
@ -25,12 +25,12 @@ CONSTANT: window-style
|
|||
<WebView> rect window-style <ViewWindow> ;
|
||||
|
||||
: load-url ( window url -- )
|
||||
[ send\ contentView ] [ <NSString> ] bi* send\ setMainFrameURL: ;
|
||||
[ send: contentView ] [ <NSString> ] bi* send: \setMainFrameURL: ;
|
||||
|
||||
: webkit-demo ( -- )
|
||||
<WebWindow>
|
||||
[ send\ center ]
|
||||
[ f send\ makeKeyAndOrderFront: ]
|
||||
[ send: center ]
|
||||
[ f send: \makeKeyAndOrderFront: ]
|
||||
[ "http://factorcode.org" load-url ] tri ;
|
||||
|
||||
: run-webkit-demo ( -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue