diff --git a/library/ui/cocoa/application-utils.factor b/library/ui/cocoa/application-utils.factor index c3ee2c3612..24d971e8b5 100644 --- a/library/ui/cocoa/application-utils.factor +++ b/library/ui/cocoa/application-utils.factor @@ -2,35 +2,33 @@ ! See http://factorcode.org/license.txt for BSD license. IN: cocoa USING: alien errors gadgets io kernel namespaces objc -objc-NSApplication objc-NSAutoreleasePool objc-NSException -objc-NSNotificationCenter objc-NSObject objc-NSView sequences -threads ; +objc-classes sequences threads ; : NSApplicationDelegateReplySuccess 0 ; : NSApplicationDelegateReplyCancel 1 ; : NSApplicationDelegateReplyFailure 2 ; : with-autorelease-pool ( quot -- ) - NSAutoreleasePool [new] slip [release] ; inline + NSAutoreleasePool -> new slip -> release ; inline -: NSApp NSApplication [sharedApplication] ; +: NSApp NSApplication -> sharedApplication ; : with-cocoa ( quot -- ) [ NSApp drop call ] with-autorelease-pool ; -: ( str -- alien ) [autorelease] ; +: ( str -- alien ) -> autorelease ; -: ( seq -- alien ) [autorelease] ; +: ( seq -- alien ) -> autorelease ; : CFRunLoopDefaultMode "kCFRunLoopDefaultMode" ; : next-event ( app -- event ) 0 f CFRunLoopDefaultMode 1 - [nextEventMatchingMask:untilDate:inMode:dequeue:] ; + -> nextEventMatchingMask:untilDate:inMode:dequeue: ; : do-event ( app -- ? ) [ - dup next-event [ [sendEvent:] t ] [ drop f ] if* + dup next-event [ -> sendEvent: t ] [ drop f ] if* ] with-autorelease-pool ; : do-events ( app -- ) @@ -41,20 +39,21 @@ threads ; event-loop ; : add-observer ( observer selector name object -- ) - >r >r >r >r NSNotificationCenter [defaultCenter] r> r> - sel_registerName r> r> [addObserver:selector:name:object:] ; + >r >r >r >r NSNotificationCenter -> defaultCenter + r> r> sel_registerName + r> r> -> addObserver:selector:name:object: ; : remove-observer ( observer -- ) - >r NSNotificationCenter [defaultCenter] r> - [removeObserver:] ; + >r NSNotificationCenter -> defaultCenter r> + -> removeObserver: ; -: finish-launching ( -- ) NSApp [finishLaunching] ; +: finish-launching ( -- ) NSApp -> finishLaunching ; : install-delegate ( receiver delegate -- ) - [alloc] [init] [setDelegate:] ; + -> alloc -> init -> setDelegate: ; IN: errors : objc-error. ( error -- ) "Objective C exception:" print - third [reason] CF>string print ; + third -> reason CF>string print ; diff --git a/library/ui/cocoa/callback.factor b/library/ui/cocoa/callback.factor index 7cbcbccab0..ef6f21c18b 100644 --- a/library/ui/cocoa/callback.factor +++ b/library/ui/cocoa/callback.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2005, 2006 Kevin Reid. ! See http://factorcode.org/license.txt for BSD license. -IN: objc-FactorCallback +IN: objc-classes DEFER: FactorCallback IN: cocoa -USING: hashtables kernel namespaces objc objc-NSObject ; +USING: hashtables kernel namespaces objc ; SYMBOL: callbacks @@ -22,11 +22,11 @@ reset-callbacks [ drop dup callbacks get remove-hash - SUPER-> [dealloc] + SUPER-> dealloc ] } } { } define-objc-class : ( quot -- id | quot: id -- ) - FactorCallback [alloc] [init] + FactorCallback -> alloc -> init [ callbacks get set-hash ] keep ; \ No newline at end of file diff --git a/library/ui/cocoa/dialogs.factor b/library/ui/cocoa/dialogs.factor index aff5e2bb03..75e83488a9 100644 --- a/library/ui/cocoa/dialogs.factor +++ b/library/ui/cocoa/dialogs.factor @@ -1,19 +1,18 @@ ! Copyright (C) 2006 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. IN: cocoa -USING: kernel objc-NSObject objc-NSOpenPanel objc-NSSavePanel -sequences ; +USING: kernel objc-classes sequences ; : ( -- panel ) - NSOpenPanel [openPanel] - dup 1 [setCanChooseFiles:] - dup 0 [setCanChooseDirectories:] - dup 1 [setResolvesAliases:] - dup 1 [setAllowsMultipleSelection:] ; + NSOpenPanel -> openPanel + dup 1 -> setCanChooseFiles: + dup 0 -> setCanChooseDirectories: + dup 1 -> setResolvesAliases: + dup 1 -> setAllowsMultipleSelection: ; : NSOKButton 1 ; : NSCancelButton 0 ; : open-panel ( -- paths ) - dup f [runModalForTypes:] NSOKButton = - [ [filenames] CF>string-array ] [ drop f ] if ; + dup f -> runModalForTypes: NSOKButton = + [ -> filenames CF>string-array ] [ drop f ] if ; diff --git a/library/ui/cocoa/load.factor b/library/ui/cocoa/load.factor index 8376434971..2236b41166 100644 --- a/library/ui/cocoa/load.factor +++ b/library/ui/cocoa/load.factor @@ -21,4 +21,4 @@ USING: compiler io parser sequences words ; ] each "Compiling Cocoa bindings..." print -vocabs [ "objc-" head? ] subset compile-vocabs +{ "cocoa" "objc" "objc-classes" } compile-vocabs diff --git a/library/ui/cocoa/menu-bar.factor b/library/ui/cocoa/menu-bar.factor index 8ddad120c4..9a42c2d417 100644 --- a/library/ui/cocoa/menu-bar.factor +++ b/library/ui/cocoa/menu-bar.factor @@ -2,9 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: cocoa compiler gadgets gadgets-browser gadgets-launchpad gadgets-layouts gadgets-listener kernel memory objc -objc-FactorCallback objc-NSApplication objc-NSMenu -objc-NSMenuItem objc-NSObject objc-NSWindow sequences strings -words ; +objc-classes sequences strings words ; IN: cocoa ! ------------------------------------------------------------------------- @@ -18,36 +16,36 @@ M: quotation to-target-and-action "perform:" sel_registerName swap ; : ( title -- ) - NSMenu [alloc] - swap [initWithTitle:] - [autorelease] ; + NSMenu -> alloc + swap -> initWithTitle: + -> autorelease ; -: set-main-menu ( menu -- ) NSApp swap [setMainMenu:] ; +: set-main-menu ( menu -- ) NSApp swap -> setMainMenu: ; : ( title action equivalent -- item ) >r >r >r - NSMenuItem [alloc] + NSMenuItem -> alloc r> r> dup [ sel_registerName ] when r> - [initWithTitle:action:keyEquivalent:] [autorelease] ; + -> initWithTitle:action:keyEquivalent: -> autorelease ; : make-menu-item ( title spec -- item ) to-target-and-action >r swap dup - r> [setTarget:] ; + r> -> setTarget: ; : submenu-to-item ( menu -- item ) - dup [title] CF>string f "" dup - rot [setSubmenu:] ; + dup -> title CF>string f "" dup + rot -> setSubmenu: ; : add-submenu ( menu submenu -- ) - submenu-to-item [addItem:] ; + submenu-to-item -> addItem: ; : and-modifiers ( item key-equivalent-modifier-mask -- item ) - dupd [setKeyEquivalentModifierMask:] ; + dupd -> setKeyEquivalentModifierMask: ; : and-alternate ( item -- item ) - dup 1 [setAlternate:] ; + dup 1 -> setAlternate: ; : and-option-equivalent-modifier 1572864 and-modifiers ; @@ -66,7 +64,7 @@ DEFER: described-menu ! this is a mess : described-item ( desc -- menu-item ) dup length 0 = [ - drop NSMenuItem [separatorItem] + drop NSMenuItem -> separatorItem ] [ dup first string? [ [ first3 swap make-menu-item ] keep @@ -79,7 +77,7 @@ DEFER: described-menu ] if ; : and-described-item ( menu desc -- same-menu ) - described-item dupd [addItem:] ; + described-item dupd -> addItem: ; : described-menu ( { title items* } -- menu ) [ first ] keep @@ -102,14 +100,14 @@ DEFER: described-menu ! Preferences goes here { { "Services" - } [ NSApp over [setServicesMenu:] ] } + } [ NSApp over -> setServicesMenu: ] } { } { "Hide Factor" "hide:" "h" } { "Hide Others" "hideOtherApplications:" "h" [ and-option-equivalent-modifier ] } { "Show All" "unhideAllApplications:" "" } { } { "Quit" "terminate:" "q" } - } [ NSApp over [setAppleMenu:] ] } + } [ NSApp over -> setAppleMenu: ] } { { "File" { "New Listener" listener-window "n" } @@ -143,7 +141,7 @@ DEFER: described-menu { "Minimize All" "miniaturizeAll:" "m" [ and-alternate and-option-equivalent-modifier ] } { } { "Bring All to Front" "arrangeInFront:" "" } - } [ NSApp over [setWindowsMenu:] ] } + } [ NSApp over -> setWindowsMenu: ] } { { "Help" { "Factor Documentation" handbook-window "?" } diff --git a/library/ui/cocoa/pasteboard-utils.factor b/library/ui/cocoa/pasteboard-utils.factor index 2660a88b3a..8cf44b5b13 100644 --- a/library/ui/cocoa/pasteboard-utils.factor +++ b/library/ui/cocoa/pasteboard-utils.factor @@ -1,21 +1,21 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: cocoa -USING: arrays kernel objc-NSPasteboard sequences ; +USING: arrays kernel objc-classes sequences ; : NSStringPboardType "NSStringPboardType" ; : pasteboard-string? ( type id -- seq ) - NSStringPboardType swap [types] CF>string-array member? ; + NSStringPboardType swap -> types CF>string-array member? ; : pasteboard-string ( id -- str ) - NSStringPboardType [stringForType:] + NSStringPboardType -> stringForType: dup [ CF>string ] when ; : set-pasteboard-types ( seq id -- ) - swap f [declareTypes:owner:] drop ; + swap f -> declareTypes:owner: drop ; : set-pasteboard-string ( str id -- ) NSStringPboardType dup 1array pick set-pasteboard-types - >r swap r> [setString:forType:] drop ; + >r swap r> -> setString:forType: drop ; diff --git a/library/ui/cocoa/services.factor b/library/ui/cocoa/services.factor index f47c388264..bdfca2e775 100644 --- a/library/ui/cocoa/services.factor +++ b/library/ui/cocoa/services.factor @@ -1,9 +1,11 @@ -IN: objc-FactorServiceProvider +! Copyright (C) 2006 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +IN: objc-classes DEFER: FactorServiceProvider IN: cocoa USING: alien gadgets-presentations io kernel namespaces objc -objc-NSApplication objc-NSObject parser prettyprint styles ; +parser prettyprint styles ; : pasteboard-error ( error str -- f ) "Pasteboard does not hold a string" @@ -36,5 +38,5 @@ objc-NSApplication objc-NSObject parser prettyprint styles ; : register-services ( -- ) NSApp - FactorServiceProvider [alloc] [init] - [setServicesProvider:] ; + FactorServiceProvider -> alloc -> init + -> setServicesProvider: ; diff --git a/library/ui/cocoa/ui.factor b/library/ui/cocoa/ui.factor index 2108a74fa7..c0554a3cc6 100644 --- a/library/ui/cocoa/ui.factor +++ b/library/ui/cocoa/ui.factor @@ -1,18 +1,16 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: objc-FactorApplicationDelegate - +IN: objc-classes DEFER: FactorApplicationDelegate IN: cocoa USING: arrays gadgets gadgets-layouts gadgets-listener -hashtables kernel namespaces objc objc-NSApplication -objc-NSObject objc-NSWindow sequences ; +hashtables kernel namespaces objc sequences errors freetype ; : finder-run-files ( alien -- ) CF>string-array listener-run-files NSApp NSApplicationDelegateReplySuccess - [replyToOpenOrPrint:] ; + -> replyToOpenOrPrint: ; ! Handle Open events from the Finder "NSObject" "FactorApplicationDelegate" { @@ -39,30 +37,28 @@ objc-NSObject objc-NSWindow sequences ; dup dup rot rect>NSRect dup install-window-delegate - over [release] + over -> release 2array ] keep set-world-handle ; IN: gadgets -USING: errors freetype objc-NSOpenGLContext -objc-NSOpenGLView objc-NSView ; : redraw-world ( world -- ) - world-handle first 1 [setNeedsDisplay:] ; + world-handle first 1 -> setNeedsDisplay: ; : set-title ( string world -- ) - world-handle second swap [setTitle:] ; + world-handle second swap -> setTitle: ; : open-window* ( world -- ) dup gadget-window dup start-world - world-handle second f [makeKeyAndOrderFront:] ; + world-handle second f -> makeKeyAndOrderFront: ; : select-gl-context ( handle -- ) - first [openGLContext] [makeCurrentContext] ; + first -> openGLContext -> makeCurrentContext ; : flush-gl-context ( handle -- ) - first [openGLContext] [flushBuffer] ; + first -> openGLContext -> flushBuffer ; IN: shells diff --git a/library/ui/cocoa/utilities.factor b/library/ui/cocoa/utilities.factor index 976c97ea5a..0e92300791 100644 --- a/library/ui/cocoa/utilities.factor +++ b/library/ui/cocoa/utilities.factor @@ -1,9 +1,54 @@ -! Copyright (C) 2006 Slava Pestov -! See http://factorcode.org/license.txt for BSD license. IN: objc -USING: alien arrays errors hashtables kernel math +USING: alien arrays errors hashtables inference kernel math namespaces parser sequences strings words ; +: make-alien-invoke [ ] make \ alien-invoke add ; inline + +: make-sender ( method function -- quot ) + [ over first , f , , second , ] make-alien-invoke ; + +: make-sender-stret ( method function -- quot ) + [ + [ "void" f ] % + "_stret" append , + { "void*" } swap second append , + ] make-alien-invoke ; + +: sender-stub ( method function -- word ) + over first c-struct? + [ make-sender-stret ] [ make-sender ] if + define-temp ; + +SYMBOL: msg-senders +H{ } clone msg-senders set-global + +SYMBOL: super-msg-senders +H{ } clone super-msg-senders set-global + +: (cache-stub) ( method function hash -- word ) + [ + over second get dup [ + 2nip + ] [ + drop over >r sender-stub dup r> second set + ] if + ] bind ; + +: cache-stub ( method super? -- word ) + [ "objc_msgSendSuper" "objc_msgSend" ? ] keep + super-msg-senders msg-senders ? get + (cache-stub) ; + +: ( receiver -- super ) + "objc-super" [ + >r dup objc-object-isa objc-class-super-class r> + set-objc-super-class + ] keep + [ set-objc-super-receiver ] keep ; + +: make-stret-quot ( returns -- quot ) + [ dup ] curry 1 make-dip ; + TUPLE: selector name object ; C: selector ( name -- sel ) [ set-selector-name ] keep ; @@ -16,10 +61,61 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ; selector-object ] if ; -: objc-classes ( -- seq ) - f 0 objc_getClassList - [ "void*" dup ] keep objc_getClassList - [ swap void*-nth objc-class-name ] map-with ; +SYMBOL: selectors + +H{ } clone selectors set-global + +: cache-selector selectors get-global [ ] cache ; + +SYMBOL: objc-methods +H{ } clone objc-methods set-global + +: lookup-method ( selector -- method ) + dup objc-methods get hash + [ ] [ "No such method: " swap append throw ] ?if ; + +: (make-prepare-send) ( selector method -- quot ) + [ + [ \ , ] when + dup first c-struct? [ make-stret-quot % ] [ drop ] if + cache-selector , \ selector , + ] [ ] make ; + +: make-prepare-send ( selector method super? -- quot ) + over second length 2 - >r (make-prepare-send) r> make-dip ; + +: make-objc-send ( selector super? -- quot ) + >r dup lookup-method r> 2dup cache-stub >r + make-prepare-send r> add ; + +: infer-send ( super? -- ) + pop-literal rot make-objc-send infer-quot-value ; + +: compile-send-error + "Objective C message sends must be compiled" throw ; + +: send ( ... selector -- ... ) compile-send-error ; + +\ send [ f infer-send ] "infer-quot" set-word-prop + +: -> scan parsed \ send parsed ; parsing + +: super-send ( ... selector -- ... ) compile-send-error ; + +\ super-send [ t infer-send ] "infer-quot" set-word-prop + +: SUPER-> scan parsed \ super-send parsed ; parsing + +! Runtime introspection +: (objc-class) ( string word -- class ) + dupd execute + [ ] [ "No such class: " swap append throw ] ?if ; inline + +: objc-class ( string -- class ) + \ objc_getClass (objc-class) ; + +: objc-meta-class ( string -- class ) + \ objc_getMetaClass (objc-class) ; : method-arg-type ( method i -- type ) f 0 over @@ -49,6 +145,7 @@ H{ { ":" "SEL" } } objc>alien-types set-global +! The transpose of the above map SYMBOL: alien>objc-types objc>alien-types get hash>alist [ reverse ] map alist>hash @@ -81,87 +178,27 @@ H{ #! Undocumented hack! Apple does not support this feature! objc-method-types parse-objc-type ; -: objc-method-info ( method -- { return name args } ) - [ method-return-type ] keep - [ objc-method-name sel_getName ] keep - method-arg-types 3array ; +: register-objc-method ( method -- ) + dup method-return-type over method-arg-types 2array + swap objc-method-name sel_getName + objc-methods get set-hash ; : method-list@ ( ptr -- ptr ) "objc-method-list" c-size swap ; -: method-list>seq ( method-list -- seq ) - dup method-list@ swap objc-method-list-count - [ swap objc-method-nth objc-method-info ] map-with ; +: (register-objc-methods) ( objc-class iterator -- ) + 2dup class_nextMethodList [ + dup method-list@ swap objc-method-list-count [ + swap objc-method-nth register-objc-method + ] each-with (register-objc-methods) + ] [ + 2drop + ] if* ; -: (objc-methods) ( objc-class iterator -- ) - 2dup class_nextMethodList - [ method-list>seq % (objc-methods) ] [ 2drop ] if* ; +: register-objc-methods ( class -- seq ) + f (register-objc-methods) ; -: objc-methods ( class -- seq ) - [ f (objc-methods) ] { } make ; - -: (objc-class) ( string word -- class ) - dupd execute - [ ] [ "No such class: " swap append throw ] ?if ; inline - -: objc-class ( string -- class ) - \ objc_getClass (objc-class) ; - -: objc-meta-class ( string -- class ) - \ objc_getMetaClass (objc-class) ; - -: class-exists? ( string -- class ) - objc_getClass >boolean ; - -: instance-methods ( classname -- seq ) - objc-class objc-methods ; - -: class-methods ( classname -- seq ) - objc-meta-class objc-methods ; - -: ( receiver class -- super ) - "objc-super" - [ set-objc-super-class ] keep - [ set-objc-super-receiver ] keep ; - -: SUPER-> \ SUPER-> on ; inline - -: ?super ( obj -- class ) - objc-object-isa \ SUPER-> [ f ] change - [ objc-class-super-class ] when ; inline - -: selector-quot ( string -- ) - [ - [ dup ?super ] % , \ selector , - ] [ ] make ; - -: make-objc-invoke - [ - >r over length 2 - make-dip % r> call \ alien-invoke , - ] [ ] make ; - -: make-objc-send ( returns args selector -- ) - selector-quot - [ swap , [ f "objc_msgSendSuper" ] % , ] make-objc-invoke ; - -: make-objc-send-stret ( returns args selector -- ) - >r swap [ dup ] curry 1 make-dip r> - selector-quot append [ - "void" , - [ f "objc_msgSendSuper_stret" ] % - { "void*" } swap append , - ] make-objc-invoke ; - -: make-objc-method ( returns args selector -- ) - pick c-struct? - [ make-objc-send-stret ] [ make-objc-send ] if ; - -: import-objc-method ( returns types selector -- ) - [ make-objc-method "[" ] keep "]" append3 create-in - swap define-compound ; - -: import-objc-methods ( seq -- ) - [ first3 swap import-objc-method ] each ; +: class-exists? ( string -- class ) objc_getClass >boolean ; : unless-defined ( class quot -- ) >r class-exists? r> unless ; inline @@ -169,18 +206,13 @@ H{ : define-objc-class-word ( name quot -- ) [ over , , \ unless-defined , dup , \ objc-class , - ] [ ] make >r create-in r> define-compound ; + ] [ ] make >r "objc-classes" create r> define-compound ; : import-objc-class ( name quot -- ) #! The quotation is prepended to the class word. It should #! "regenerate" the class as appropriate (by loading a #! framework or defining the class in some manner). - 2dup unless-defined [ - "objc-" pick append in set - dupd define-objc-class-word - dup instance-methods import-objc-methods - class-methods import-objc-methods - ] with-scope ; - -: root-class ( class -- class ) - dup objc-class-super-class [ root-class ] [ ] ?if ; + 2dup unless-defined + dupd define-objc-class-word + dup objc-class register-objc-methods + objc-meta-class register-objc-methods ; diff --git a/library/ui/cocoa/view-utils.factor b/library/ui/cocoa/view-utils.factor index c792390f79..2b2c6bf2b3 100644 --- a/library/ui/cocoa/view-utils.factor +++ b/library/ui/cocoa/view-utils.factor @@ -1,35 +1,33 @@ ! Copyright (C) 2006 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -IN: objc-FactorView +IN: objc-classes DEFER: FactorView IN: cocoa USING: arrays gadgets gadgets-layouts hashtables kernel math -namespaces objc objc-NSEvent objc-NSObject -objc-NSOpenGLContext objc-NSOpenGLView objc-NSView opengl -sequences ; +namespaces objc opengl sequences ; : ( class dim -- view ) - >r [alloc] 0 0 r> first2 - NSOpenGLView [defaultPixelFormat] - [initWithFrame:pixelFormat:] - dup 1 [setPostsBoundsChangedNotifications:] - dup 1 [setPostsFrameChangedNotifications:] ; + >r -> alloc 0 0 r> first2 + NSOpenGLView -> defaultPixelFormat + -> initWithFrame:pixelFormat: + dup 1 -> setPostsBoundsChangedNotifications: + dup 1 -> setPostsFrameChangedNotifications: ; -: view-dim [bounds] dup NSRect-w swap NSRect-h 0 3array ; +: view-dim -> bounds dup NSRect-w swap NSRect-h 0 3array ; : mouse-location ( view event -- loc ) over >r - [locationInWindow] f [convertPoint:fromView:] + -> locationInWindow f -> convertPoint:fromView: dup NSPoint-x swap NSPoint-y - r> [frame] NSRect-h swap - 0 3array ; + r> -> frame NSRect-h swap - 0 3array ; : send-mouse-moved ( view event -- ) over >r mouse-location r> window move-hand ; : button ( event -- n ) #! Cocoa -> Factor UI button mapping - [buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ; + -> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } hash ; : button&loc ( view event -- button# loc ) dup button -rot mouse-location ; @@ -57,18 +55,18 @@ sequences ; } ; : key-code ( event -- string ) - dup [keyCode] key-codes hash - [ ] [ [charactersIgnoringModifiers] CF>string ] ?if ; + dup -> keyCode key-codes hash + [ ] [ -> charactersIgnoringModifiers CF>string ] ?if ; : event>gesture ( event -- modifiers keycode ) - dup [modifierFlags] modifiers modifier swap key-code ; + dup -> modifierFlags modifiers modifier swap key-code ; : send-key-event ( view event quot -- ) >r event>gesture r> call swap window world-focus handle-gesture ; inline : send-user-input ( view event -- ) - [characters] CF>string swap window world-focus user-input ; + -> characters CF>string swap window world-focus user-input ; : send-key-down-event ( view event -- ) 2dup [ ] send-key-event @@ -84,7 +82,7 @@ sequences ; over >r button&loc r> window send-button-up ; : send-wheel$ ( view event -- ) - [ [deltaY] 0 > ] 2keep mouse-location + [ -> deltaY 0 > ] 2keep mouse-location rot window send-wheel ; : add-resize-observer ( observer object -- ) @@ -160,7 +158,7 @@ sequences ; { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" } [ rot drop - SUPER-> [initWithFrame:pixelFormat:] + SUPER-> initWithFrame:pixelFormat: dup dup add-resize-observer ] } @@ -171,7 +169,7 @@ sequences ; dup window close-world dup unregister-window dup remove-observer - SUPER-> [dealloc] + SUPER-> dealloc ] } } { } define-objc-class diff --git a/library/ui/cocoa/window-utils.factor b/library/ui/cocoa/window-utils.factor index 9a29d71011..f7de503037 100644 --- a/library/ui/cocoa/window-utils.factor +++ b/library/ui/cocoa/window-utils.factor @@ -1,11 +1,10 @@ ! Copyright (C) 2006 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -IN: objc-FactorWindowDelegate +IN: objc-classes DEFER: FactorWindowDelegate IN: cocoa USING: arrays gadgets gadgets-layouts kernel math objc -objc-NSNotification objc-NSObject objc-NSView objc-NSWindow sequences ; : NSBorderlessWindowMask 0 ; inline @@ -25,24 +24,24 @@ sequences ; NSResizableWindowMask bitor ; inline : ( rect -- window ) - NSWindow [alloc] swap + NSWindow -> alloc swap standard-window-type NSBackingStoreBuffered 1 - [initWithContentRect:styleMask:backing:defer:] ; + -> initWithContentRect:styleMask:backing:defer: ; : ( view bounds -- window ) - [ swap [setContentView:] ] keep - dup dup [contentView] [setInitialFirstResponder:] - dup 1 [setAcceptsMouseMovedEvents:] ; + [ swap -> setContentView: ] keep + dup dup -> contentView -> setInitialFirstResponder: + dup 1 -> setAcceptsMouseMovedEvents: ; -: window-pref-dim [contentView] window pref-dim ; +: window-pref-dim -> contentView window pref-dim ; : frame-content-rect ( window rect -- rect ) - swap [styleMask] NSWindow -rot - [frameRectForContentRect:styleMask:] ; + swap -> styleMask NSWindow -rot + -> frameRectForContentRect:styleMask: ; : window-content-rect ( window -- rect ) - NSWindow over [frame] rot [styleMask] - [contentRectForFrameRect:styleMask:] ; + NSWindow over -> frame rot -> styleMask + -> contentRectForFrameRect:styleMask: ; "NSObject" "FactorWindowDelegate" { { @@ -58,21 +57,21 @@ sequences ; { "windowDidMove:" "void" { "id" "SEL" "id" } [ - 2nip [object] + 2nip -> object dup window-content-rect NSRect-x-y 0 3array - swap [contentView] window set-world-loc + swap -> contentView window set-world-loc ] } { "windowDidBecomeKey:" "void" { "id" "SEL" "id" } [ - 2nip [object] [contentView] window focus-world + 2nip -> object -> contentView window focus-world ] } { "windowDidResignKey:" "void" { "id" "SEL" "id" } [ - 2nip [object] [contentView] window unfocus-world + 2nip -> object -> contentView window unfocus-world ] } } { } define-objc-class