diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index eefc04e2a1..fee8c60c21 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -4,14 +4,12 @@ tools.test memory compiler.units math core-graphics.types ; FROM: alien.c-types => int void ; IN: cocoa.tests -CLASS: { - { +superclass+ "NSObject" } - { +name+ "Foo" } -} - -METHOD: void foo: NSRect rect [ - gc rect "x" set -] ; +CLASS: Foo < NSObject +[ + METHOD: void foo: NSRect rect [ + gc rect "x" set + ] +] : test-foo ( -- ) Foo -> alloc -> init @@ -25,12 +23,10 @@ test-foo [ 101.0 ] [ "x" get CGRect-w ] unit-test [ 102.0 ] [ "x" get CGRect-h ] unit-test -CLASS: { - { +superclass+ "NSObject" } - { +name+ "Bar" } -} - -METHOD: NSRect bar [ test-foo "x" get ] ; +CLASS: Bar < NSObject +[ + METHOD: NSRect bar [ test-foo "x" get ] +] Bar [ -> alloc -> init @@ -44,14 +40,12 @@ Bar [ [ 102.0 ] [ "x" get CGRect-h ] unit-test ! Make sure that we can add methods -CLASS: { - { +superclass+ "NSObject" } - { +name+ "Bar" } -} +CLASS: Bar < NSObject +[ + METHOD: NSRect bar [ test-foo "x" get ] -METHOD: NSRect bar [ test-foo "x" get ] - -METHOD: int babb: int x [ x sq ] ; + METHOD: int babb: int x [ x sq ] +] [ 144 ] [ Bar [ diff --git a/basis/cocoa/subclassing/subclassing-docs.factor b/basis/cocoa/subclassing/subclassing-docs.factor index 2e1d973169..2c83e60dde 100644 --- a/basis/cocoa/subclassing/subclassing-docs.factor +++ b/basis/cocoa/subclassing/subclassing-docs.factor @@ -1,41 +1,10 @@ USING: help.markup help.syntax strings alien hashtables ; IN: cocoa.subclassing -HELP: define-objc-class -{ $values { "imeth" "a sequence of instance method definitions" } { "hash" hashtable } } -{ $description "Defines a new Objective C class. The hashtable can contain the following keys:" - { $list - { { $link +name+ } " - a string naming the new class. Required." } - { { $link +superclass+ } " - a string naming the superclass. Required." } - { { $link +protocols+ } " - an array of strings naming protocols implemented by the superclass. Optional." } - } -"Every element of " { $snippet "imeth" } " defines an instance method, and is an array having the shape " -{ $snippet "{ name return args quot }" } -".:" -{ $table - { "name" { "a selector name" } } - { "name" { "a C type name; see " { $link "c-data" } } } - { "args" { "a sequence of C type names; see " { $link "c-data" } } } - { "quot" { "a quotation to be run as a callback when the method is invoked; see " { $link alien-callback } } } -} -"The quotation is run with the following values on the stack:" -{ $list - { "the receiver of the message; an " { $link alien } " pointing to an instance of this class" } - { "the selector naming the message; in most cases this value can be ignored" } - "arguments passed to the message, if any" -} -"There is no way to define instance variables or class methods using this mechanism. However, instance variables can be simulated by using the receiver to key into an assoc." } ; - HELP: CLASS: -{ $syntax "CLASS: spec imeth... ;" } -{ $values { "spec" "an array of pairs" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } } -{ $description "Defines a new Objective C class. The hashtable can contain the following keys:" -{ $list - { { $link +name+ } " - a string naming the new class. Required." } - { { $link +superclass+ } " - a string naming the superclass. Required." } - { { $link +protocols+ } " - an array of strings naming protocols implemented by the superclass. Optional." } -} -"Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word." +{ $syntax "CLASS: name < superclass protocols... [ imeth... ]" } +{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } } +{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word." $nl "This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ; @@ -49,8 +18,6 @@ HELP: METHOD: ARTICLE: "objc-subclassing" "Subclassing Objective C classes" "Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:" { $subsections POSTPONE: CLASS: POSTPONE: METHOD: } -"This word is actually syntax sugar for an ordinary word:" -{ $subsections define-objc-class } "Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ; IN: cocoa.subclassing diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index 4c5099e04b..b88d3afd7b 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -29,7 +29,7 @@ IN: cocoa.subclassing : add-protocols ( protocols class -- ) '[ [ _ ] dip objc-protocol add-protocol ] each ; -: (define-objc-class) ( imeth protocols superclass name -- ) +: (define-objc-class) ( methods protocols superclass name -- ) [ objc-class ] dip 0 objc_allocateClassPair [ add-protocols ] [ add-methods ] [ objc_registerClassPair ] tri ; @@ -59,28 +59,23 @@ IN: cocoa.subclassing class sel imp types add-method ] if* ; -: redefine-objc-methods ( imeth name -- ) +: redefine-objc-methods ( methods name -- ) dup class-exists? [ objc_getClass '[ [ _ ] dip (redefine-objc-method) ] each ] [ 2drop ] if ; -SYMBOL: +name+ -SYMBOL: +protocols+ -SYMBOL: +superclass+ - -: define-objc-class ( imeth hash -- ) - clone [ - prepare-methods - +name+ get "cocoa.classes" create drop - +name+ get 2dup redefine-objc-methods swap - +protocols+ get +superclass+ get +name+ get - '[ _ _ _ _ (define-objc-class) ] - import-objc-class - ] bind ; +:: define-objc-class ( name superclass protocols methods -- ) + methods prepare-methods :> methods + name "cocoa.classes" create drop + methods name redefine-objc-methods + name [ methods protocols superclass name (define-objc-class) ] import-objc-class ; SYNTAX: CLASS: - parse-definition unclip - >hashtable define-objc-class ; + scan-token + "<" expect + scan-token + "[" parse-tokens + \ ] parse-until define-objc-class ; : (parse-selector) ( -- ) scan-token { diff --git a/basis/tools/deploy/test/14/14.factor b/basis/tools/deploy/test/14/14.factor index 0b98b45d68..95ab68916a 100644 --- a/basis/tools/deploy/test/14/14.factor +++ b/basis/tools/deploy/test/14/14.factor @@ -6,16 +6,14 @@ kernel math ; FROM: alien.c-types => float ; IN: tools.deploy.test.14 -CLASS: { - { +superclass+ "NSObject" } - { +name+ "Bar" } -} - -METHOD: float bar: NSRect rect [ - rect origin>> [ x>> ] [ y>> ] bi + - rect size>> [ w>> ] [ h>> ] bi + - + -] ; +CLASS: Bar < NSObject +[ + METHOD: float bar: NSRect rect [ + rect origin>> [ x>> ] [ y>> ] bi + + rect size>> [ w>> ] [ h>> ] bi + + + + ] +] : main ( -- ) Bar -> alloc -> init diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 65286ab181..13f07b9d41 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -228,12 +228,11 @@ M: cocoa-ui-backend system-alert ] [ 2drop ] if* init-thread-timer ; -CLASS: { - { +superclass+ "NSObject" } - { +name+ "FactorApplicationDelegate" } -} - -METHOD: void applicationDidUpdate: id obj [ reset-run-loop ] ; +CLASS: FactorApplicationDelegate < NSObject +[ + METHOD: void applicationDidUpdate: id obj + [ reset-run-loop ] +] : install-app-delegate ( -- ) NSApp FactorApplicationDelegate install-delegate ; diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor index e41531b587..bacd6f02e4 100644 --- a/basis/ui/backend/cocoa/tools/tools.factor +++ b/basis/ui/backend/cocoa/tools/tools.factor @@ -21,30 +21,28 @@ IN: ui.backend.cocoa.tools image save-panel [ save-image ] when* ; ! Handle Open events from the Finder -CLASS: { - { +superclass+ "FactorApplicationDelegate" } - { +name+ "FactorWorkspaceApplicationDelegate" } -} +CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate +[ + METHOD: void application: id app openFiles: id files [ files finder-run-files ] -METHOD: void application: id app openFiles: id files [ files finder-run-files ] + METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ] -METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ] + METHOD: id factorListener: id app [ show-listener f ] -METHOD: id factorListener: id app [ show-listener f ] + METHOD: id factorBrowser: id app [ show-browser f ] -METHOD: id factorBrowser: id app [ show-browser f ] + METHOD: id newFactorListener: id app [ listener-window f ] -METHOD: id newFactorListener: id app [ listener-window f ] + METHOD: id newFactorBrowser: id app [ browser-window f ] -METHOD: id newFactorBrowser: id app [ browser-window f ] + METHOD: id runFactorFile: id app [ menu-run-files f ] -METHOD: id runFactorFile: id app [ menu-run-files f ] + METHOD: id saveFactorImage: id app [ save f ] -METHOD: id saveFactorImage: id app [ save f ] + METHOD: id saveFactorImageAs: id app [ menu-save-image f ] -METHOD: id saveFactorImageAs: id app [ menu-save-image f ] - -METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ; + METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] +] : install-app-delegate ( -- ) NSApp FactorWorkspaceApplicationDelegate install-delegate ; @@ -55,19 +53,17 @@ METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] dup [ quot call( string -- result/f ) ] when [ pboard set-pasteboard-string ] when* ; -CLASS: { - { +superclass+ "NSObject" } - { +name+ "FactorServiceProvider" } -} - -METHOD: void evalInListener: id pboard userData: id userData error: id error -[ pboard error [ eval-listener f ] do-service ] - -METHOD: void evalToString: id pboard userData: id userData error: id error +CLASS: FactorServiceProvider < NSObject [ - pboard error - [ [ (eval>string) ] with-interactive-vocabs ] do-service -] ; + METHOD: void evalInListener: id pboard userData: id userData error: id error + [ pboard error [ eval-listener f ] do-service ] + + METHOD: void evalToString: id pboard userData: id userData error: id error + [ + pboard error + [ [ (eval>string) ] with-interactive-vocabs ] do-service + ] +] : register-services ( -- ) NSApp diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 6b6e3a32c6..e98c31b295 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -3,14 +3,16 @@ USING: accessors alien alien.c-types alien.data alien.strings arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views cocoa.application cocoa.pasteboard -cocoa.runtime cocoa.types cocoa.windows sequences io.encodings.utf8 -ui ui.private ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures -core-foundation.strings core-graphics core-graphics.types threads -combinators math.rectangles ; +cocoa.runtime cocoa.types cocoa.windows sequences +io.encodings.utf8 locals ui ui.private ui.gadgets +ui.gadgets.private ui.gadgets.worlds ui.gestures +core-foundation.strings core-graphics core-graphics.types +threads combinators math.rectangles ; IN: ui.backend.cocoa.views : send-mouse-moved ( view event -- ) - [ mouse-location ] [ drop window ] 2bi move-hand fire-motion yield ; + [ mouse-location ] [ drop window ] 2bi + dup [ move-hand fire-motion yield ] [ 2drop ] if ; : button ( event -- n ) #! Cocoa -> Factor UI button mapping @@ -62,7 +64,7 @@ CONSTANT: key-codes [ event-modifiers ] [ key-code ] bi ; : send-key-event ( view gesture -- ) - swap window propagate-key-gesture ; + swap window dup [ propagate-key-gesture ] [ 2drop ] if ; : interpret-key-event ( view event -- ) NSArray swap -> arrayWithObject: -> interpretKeyEvents: ; @@ -82,22 +84,25 @@ CONSTANT: key-codes [ nip mouse-event>gesture ] [ mouse-location ] [ drop window ] - 2tri send-button-down ; + 2tri + dup [ send-button-down ] [ 3drop ] if ; : send-button-up$ ( view event -- ) [ nip mouse-event>gesture ] [ mouse-location ] [ drop window ] - 2tri send-button-up ; + 2tri + dup [ send-button-up ] [ 3drop ] if ; : send-scroll$ ( view event -- ) [ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ] [ mouse-location ] [ drop window ] - 2tri send-scroll ; + 2tri + dup [ send-scroll ] [ 3drop ] if ; -: send-action$ ( view event gesture -- junk ) - [ drop window ] dip send-action f ; +: send-action$ ( view event gesture -- ) + [ drop window ] dip over [ send-action ] [ 2drop ] if ; : add-resize-observer ( observer object -- ) [ @@ -141,176 +146,191 @@ CONSTANT: selector>action H{ selector>action at [ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ; -CLASS: { - { +superclass+ "NSOpenGLView" } - { +name+ "FactorView" } - { +protocols+ { "NSTextInput" } } -} - -! Rendering -METHOD: void drawRect: NSRect rect [ self window draw-world ] - -! Events -METHOD: char acceptsFirstMouse: id event [ 1 ] - -METHOD: void mouseEntered: id event [ self event send-mouse-moved ] - -METHOD: void mouseExited: id event [ forget-rollover ] - -METHOD: void mouseMoved: id event [ self event send-mouse-moved ] - -METHOD: void mouseDragged: id event [ self event send-mouse-moved ] - -METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ] - -METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ] - -METHOD: void mouseDown: id event [ self event send-button-down$ ] - -METHOD: void mouseUp: id event [ self event send-button-up$ ] - -METHOD: void rightMouseDown: id event [ self event send-button-down$ ] - -METHOD: void rightMouseUp: id event [ self event send-button-up$ ] - -METHOD: void otherMouseDown: id event [ self event send-button-down$ ] - -METHOD: void otherMouseUp: id event [ self event send-button-up$ ] - -METHOD: void scrollWheel: id event [ self event send-scroll$ ] - -METHOD: void keyDown: id event [ self event send-key-down-event ] - -METHOD: void keyUp: id event [ self event send-key-up-event ] - -METHOD: char validateUserInterfaceItem: id event +CLASS: FactorView < NSOpenGLView NSTextInput [ - self window - event -> action utf8 alien>string validate-action - [ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if + ! Rendering + METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ] + + ! Events + METHOD: char acceptsFirstMouse: id event [ 1 ] + + METHOD: void mouseEntered: id event [ self event send-mouse-moved ] + + METHOD: void mouseExited: id event [ forget-rollover ] + + METHOD: void mouseMoved: id event [ self event send-mouse-moved ] + + METHOD: void mouseDragged: id event [ self event send-mouse-moved ] + + METHOD: void rightMouseDragged: id event [ self event send-mouse-moved ] + + METHOD: void otherMouseDragged: id event [ self event send-mouse-moved ] + + METHOD: void mouseDown: id event [ self event send-button-down$ ] + + METHOD: void mouseUp: id event [ self event send-button-up$ ] + + METHOD: void rightMouseDown: id event [ self event send-button-down$ ] + + METHOD: void rightMouseUp: id event [ self event send-button-up$ ] + + METHOD: void otherMouseDown: id event [ self event send-button-down$ ] + + METHOD: void otherMouseUp: id event [ self event send-button-up$ ] + + METHOD: void scrollWheel: id event [ self event send-scroll$ ] + + METHOD: void keyDown: id event [ self event send-key-down-event ] + + METHOD: void keyUp: id event [ self event send-key-up-event ] + + METHOD: char validateUserInterfaceItem: id event + [ + self window [ + event -> action utf8 alien>string validate-action + [ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if + ] [ 0 ] if* + ] + + METHOD: id undo: id event [ self event undo-action send-action$ f ] + + METHOD: id redo: id event [ self event redo-action send-action$ f ] + + METHOD: id cut: id event [ self event cut-action send-action$ f ] + + METHOD: id copy: id event [ self event copy-action send-action$ f ] + + METHOD: id paste: id event [ self event paste-action send-action$ f ] + + METHOD: id delete: id event [ self event delete-action send-action$ f ] + + METHOD: id selectAll: id event [ self event select-all-action send-action$ f ] + + METHOD: id newDocument: id event [ self event new-action send-action$ f ] + + METHOD: id openDocument: id event [ self event open-action send-action$ f ] + + METHOD: id saveDocument: id event [ self event save-action send-action$ f ] + + METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ f ] + + METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ f ] + + ! Multi-touch gestures + METHOD: void magnifyWithEvent: id event + [ + self event + dup -> deltaZ sgn { + { 1 [ zoom-in-action send-action$ ] } + { -1 [ zoom-out-action send-action$ ] } + { 0 [ 2drop ] } + } case + ] + + METHOD: void swipeWithEvent: id event + [ + self event + dup -> deltaX sgn { + { 1 [ left-action send-action$ ] } + { -1 [ right-action send-action$ ] } + { 0 + [ + dup -> deltaY sgn { + { 1 [ up-action send-action$ ] } + { -1 [ down-action send-action$ ] } + { 0 [ 2drop ] } + } case + ] + } + } case + ] + + METHOD: char acceptsFirstResponder [ 1 ] + + ! Services + METHOD: id validRequestorForSendType: id sendType returnType: id returnType + [ + ! We return either self or nil + self window [ + world-focus sendType returnType + valid-service? [ self ] [ f ] if + ] [ f ] if* + ] + + METHOD: char writeSelectionToPasteboard: id pboard types: id types + [ + NSStringPboardType types CF>string-array member? [ + self window [ + world-focus gadget-selection + [ pboard set-pasteboard-string 1 ] [ 0 ] if* + ] [ 0 ] if* + ] [ 0 ] if + ] + + METHOD: char readSelectionFromPasteboard: id pboard + [ + self window :> window + window [ + pboard pasteboard-string + [ window user-input 1 ] [ 0 ] if* + ] [ 0 ] if + ] + + ! Text input + METHOD: void insertText: id text + [ + self window :> window + window [ + text CF>string window user-input + ] when + ] + + METHOD: char hasMarkedText [ 0 ] + + METHOD: NSRange markedRange [ 0 0 ] + + METHOD: NSRange selectedRange [ 0 0 ] + + METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] + + METHOD: void unmarkText [ ] + + METHOD: id validAttributesForMarkedText [ NSArray -> array ] + + METHOD: id attributedSubstringFromRange: NSRange range [ f ] + + METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] + + METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 ] + + METHOD: NSInteger conversationIdentifier [ self alien-address ] + + ! Initialization + METHOD: void updateFactorGadgetSize: id notification + [ + self window :> window + window [ + self view-dim window dim<< yield + ] when + ] + + METHOD: void doCommandBySelector: SEL selector [ ] + + METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat + [ + self frame pixelFormat SUPER-> initWithFrame:pixelFormat: + dup dup add-resize-observer + ] + + METHOD: char isOpaque [ 0 ] + + METHOD: void dealloc + [ + self remove-observer + self SUPER-> dealloc + ] ] -METHOD: id undo: id event [ self event undo-action send-action$ ] - -METHOD: id redo: id event [ self event redo-action send-action$ ] - -METHOD: id cut: id event [ self event cut-action send-action$ ] - -METHOD: id copy: id event [ self event copy-action send-action$ ] - -METHOD: id paste: id event [ self event paste-action send-action$ ] - -METHOD: id delete: id event [ self event delete-action send-action$ ] - -METHOD: id selectAll: id event [ self event select-all-action send-action$ ] - -METHOD: id newDocument: id event [ self event new-action send-action$ ] - -METHOD: id openDocument: id event [ self event open-action send-action$ ] - -METHOD: id saveDocument: id event [ self event save-action send-action$ ] - -METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ ] - -METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ ] - -! Multi-touch gestures -METHOD: void magnifyWithEvent: id event -[ - self event - dup -> deltaZ sgn { - { 1 [ zoom-in-action send-action$ drop ] } - { -1 [ zoom-out-action send-action$ drop ] } - { 0 [ 2drop ] } - } case -] - -METHOD: void swipeWithEvent: id event -[ - self event - dup -> deltaX sgn { - { 1 [ left-action send-action$ drop ] } - { -1 [ right-action send-action$ drop ] } - { 0 - [ - dup -> deltaY sgn { - { 1 [ up-action send-action$ drop ] } - { -1 [ down-action send-action$ drop ] } - { 0 [ 2drop ] } - } case - ] - } - } case -] - -METHOD: char acceptsFirstResponder [ 1 ] - -! Services -METHOD: id validRequestorForSendType: id sendType returnType: id returnType -[ - ! We return either self or nil - self window world-focus sendType returnType - valid-service? [ self ] [ f ] if -] - -METHOD: char writeSelectionToPasteboard: id pboard types: id types -[ - NSStringPboardType types CF>string-array member? [ - self window world-focus gadget-selection - [ pboard set-pasteboard-string 1 ] [ 0 ] if* - ] [ 0 ] if -] - -METHOD: char readSelectionFromPasteboard: id pboard -[ - pboard pasteboard-string - [ self window user-input 1 ] [ 0 ] if* -] - -! Text input -METHOD: void insertText: id text -[ text CF>string self window user-input ] - -METHOD: char hasMarkedText [ 0 ] - -METHOD: NSRange markedRange [ 0 0 ] - -METHOD: NSRange selectedRange [ 0 0 ] - -METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] - -METHOD: void unmarkText [ ] - -METHOD: id validAttributesForMarkedText [ NSArray -> array ] - -METHOD: id attributedSubstringFromRange: NSRange range [ f ] - -METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] - -METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 ] - -METHOD: NSInteger conversationIdentifier [ self alien-address ] - -! Initialization -METHOD: void updateFactorGadgetSize: id notification -[ self view-dim self window dim<< yield ] - -METHOD: void doCommandBySelector: SEL selector [ ] - -METHOD: id initWithFrame: NSRect frame pixelFormat: id pixelFormat -[ - self frame pixelFormat SUPER-> initWithFrame:pixelFormat: - dup dup add-resize-observer -] - -METHOD: char isOpaque [ 0 ] - -METHOD: void dealloc -[ - self remove-observer - self SUPER-> dealloc -] ; - : sync-refresh-to-screen ( GLView -- ) -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 CGLSetParameter drop ; @@ -321,38 +341,39 @@ METHOD: void dealloc : save-position ( world window -- ) -> frame CGRect-top-left 2array >>window-loc drop ; -CLASS: { - { +name+ "FactorWindowDelegate" } - { +superclass+ "NSObject" } -} - -METHOD: void windowDidMove: id notification +CLASS: FactorWindowDelegate < NSObject [ - notification -> object -> contentView window - notification -> object save-position + METHOD: void windowDidMove: id notification + [ + notification -> object -> contentView window + [ notification -> object save-position ] when* + ] + + METHOD: void windowDidBecomeKey: id notification + [ + notification -> object -> contentView window + [ focus-world ] when* + ] + + METHOD: void windowDidResignKey: id notification + [ + forget-rollover + notification -> object -> contentView :> view + view window :> window + window [ + view -> isInFullScreenMode 0 = + [ window unfocus-world ] when + ] when + ] + + METHOD: char windowShouldClose: id notification [ 1 ] + + METHOD: void windowWillClose: id notification + [ + notification -> object -> contentView + [ window ungraft ] [ unregister-window ] bi + ] ] -METHOD: void windowDidBecomeKey: id notification -[ - notification -> object -> contentView window - focus-world -] - -METHOD: void windowDidResignKey: id notification -[ - forget-rollover - notification -> object -> contentView - dup -> isInFullScreenMode 0 = - [ window [ unfocus-world ] when* ] [ drop ] if -] - -METHOD: char windowShouldClose: id notification [ 1 ] - -METHOD: void windowWillClose: id notification -[ - notification -> object -> contentView - [ window ungraft ] [ unregister-window ] bi -] ; - : install-window-delegate ( window -- ) FactorWindowDelegate install-delegate ;