Cocoa cleanup, AppleEvent handling, services
parent
f7210644a3
commit
703b6f58dd
|
@ -12,5 +12,22 @@
|
|||
<string>Factor</string>
|
||||
<key>CFBundlePackageType</key>
|
||||
<string>APPL</string>
|
||||
<key>CFBundleDocumentTypes</key>
|
||||
<array>
|
||||
<dict>
|
||||
<key>CFBundleTypeExtensions</key>
|
||||
<array>
|
||||
<string>*</string>
|
||||
</array>
|
||||
<key>CFBundleTypeName</key>
|
||||
<string>Any</string>
|
||||
<key>CFBundleTypeRole</key>
|
||||
<string>Viewer</string>
|
||||
<key>CFBundleTypeOSTypes</key>
|
||||
<array>
|
||||
<string>****</string>
|
||||
</array>
|
||||
</dict>
|
||||
</array>
|
||||
</dict>
|
||||
</plist>
|
||||
|
|
|
@ -1,7 +1,24 @@
|
|||
- fix compiled gc check
|
||||
+ refactor style stack code so that nested styles are handled at a lower-level
|
||||
- in HTML, we can nest div tags, etc
|
||||
- fix prettyprinter's highlighting of non-leaves looks bad
|
||||
- maybe even go from markup to HTML?
|
||||
- fix remaining HTML stream issues
|
||||
- need to present $list in a useful way
|
||||
- better line spacing in ui and html - related issue
|
||||
|
||||
+ tabular formatting in UI
|
||||
- inspector
|
||||
- how does this interact with outliner?
|
||||
- $values
|
||||
- other help aspects
|
||||
- grid layout
|
||||
|
||||
+ fix compiled gc check
|
||||
- there was a performance hit, investigate
|
||||
- float boxing and overflow checks need a gc check too
|
||||
|
||||
- code walker & exceptions -- test and debug problems
|
||||
- code walker and callbacks is broken?
|
||||
- prettyprinter's highlighting of non-leaves looks bad
|
||||
- look at xref issue
|
||||
|
||||
+ io:
|
||||
|
@ -19,18 +36,20 @@
|
|||
- method ordering and interpreter algorithm sections need updates
|
||||
- document that can <void*> only be called with an alien
|
||||
- help search
|
||||
- fix remaining HTML stream issues
|
||||
- automatically update help graph when adding/removing articles/words
|
||||
- document conventions
|
||||
- new turtle graphics tutorial
|
||||
- better line spacing in ui and html
|
||||
- tabular formatting - for inspector, changes and $values in help
|
||||
- grid layout
|
||||
- make the help look better, something like this:
|
||||
http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
|
||||
|
||||
+ ui/help:
|
||||
|
||||
- new leaner help viewer
|
||||
- new inspector style:
|
||||
- clicking objects sends them to the listener
|
||||
- right click sends to listener & pushes on the stack
|
||||
- debugger:
|
||||
- continuation viewer tool, reuse old inspector code
|
||||
- show a clickable menu of restarts...
|
||||
- reuse windows where possible
|
||||
- new browser:
|
||||
- browse generic words and classes
|
||||
- need actions for reloading the source file and opening word in jEdit
|
||||
|
|
|
@ -6,6 +6,10 @@ objc-NSApplication objc-NSAutoreleasePool objc-NSException
|
|||
objc-NSNotificationCenter objc-NSObject objc-NSView sequences
|
||||
threads ;
|
||||
|
||||
: NSApplicationDelegateReplySuccess 0 ;
|
||||
: NSApplicationDelegateReplyCancel 1 ;
|
||||
: NSApplicationDelegateReplyFailure 2 ;
|
||||
|
||||
: with-autorelease-pool ( quot -- )
|
||||
NSAutoreleasePool [new] slip [release] ; inline
|
||||
|
||||
|
@ -14,7 +18,9 @@ threads ;
|
|||
: with-cocoa ( quot -- )
|
||||
[ NSApp drop call ] with-autorelease-pool ;
|
||||
|
||||
: <NSString> <CFString> [autorelease] ;
|
||||
: <NSString> ( str -- alien ) <CFString> [autorelease] ;
|
||||
|
||||
: <NSArray> ( seq -- alien ) <CFArray> [autorelease] ;
|
||||
|
||||
: CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;
|
||||
|
||||
|
|
|
@ -6,14 +6,14 @@ namespaces sequences ;
|
|||
|
||||
TYPEDEF: int CFIndex
|
||||
|
||||
FUNCTION void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
|
||||
|
||||
FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
|
||||
|
||||
FUNCTION: void* CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
|
||||
|
||||
FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
|
||||
|
||||
: CF>array ( alien -- array )
|
||||
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
|
||||
|
||||
! Core Foundation utilities -- will be moved elsewhere
|
||||
: kCFURLPOSIXPathStyle 0 ;
|
||||
|
||||
FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
|
||||
|
@ -36,6 +36,14 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
|
|||
|
||||
FUNCTION: void CFRelease ( void* cf ) ;
|
||||
|
||||
: CF>array ( alien -- array )
|
||||
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
|
||||
|
||||
: <CFArray> ( seq -- array )
|
||||
[ f swap length f CFArrayCreateMutable ] keep
|
||||
[ length ] keep
|
||||
[ >r dupd r> CFArraySetValueAtIndex ] 2each ;
|
||||
|
||||
: <CFString> ( string -- cf )
|
||||
f swap dup length CFStringCreateWithCharacters ;
|
||||
|
||||
|
@ -44,6 +52,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
|
|||
>r 0 over CFStringGetLength r> CFStringGetCharacters
|
||||
] keep alien>u16-string ;
|
||||
|
||||
: CF>string-array ( alien -- seq )
|
||||
CF>array [ CF>string ] map ;
|
||||
|
||||
: <CFFileSystemURL> ( string dir? -- cf )
|
||||
>r <CFString> f over kCFURLPOSIXPathStyle
|
||||
r> CFURLCreateWithFileSystemPath swap CFRelease ;
|
||||
|
|
|
@ -16,4 +16,4 @@ sequences ;
|
|||
|
||||
: open-panel ( -- paths )
|
||||
<NSOpenPanel> dup f [runModalForTypes:] NSOKButton =
|
||||
[ [filenames] CF>array [ CF>string ] map ] [ drop f ] if ;
|
||||
[ [filenames] CF>string-array ] [ drop f ] if ;
|
||||
|
|
|
@ -20,6 +20,7 @@ USING: cocoa compiler io kernel objc sequences words ;
|
|||
"NSOpenGLContext"
|
||||
"NSOpenGLView"
|
||||
"NSOpenPanel"
|
||||
"NSPasteboard"
|
||||
"NSSavePanel"
|
||||
"NSView"
|
||||
"NSWindow"
|
||||
|
|
|
@ -9,10 +9,12 @@ USING: compiler io parser sequences words ;
|
|||
"/library/cocoa/init-cocoa.factor"
|
||||
"/library/cocoa/callback.factor"
|
||||
"/library/cocoa/application-utils.factor"
|
||||
"/library/cocoa/window-utils.factor"
|
||||
"/library/cocoa/view-utils.factor"
|
||||
"/library/cocoa/window-utils.factor"
|
||||
"/library/cocoa/dialogs.factor"
|
||||
"/library/cocoa/menu-bar.factor"
|
||||
"/library/cocoa/pasteboard-utils.factor"
|
||||
"/library/cocoa/services.factor"
|
||||
"/library/cocoa/ui.factor"
|
||||
} [
|
||||
run-resource
|
||||
|
|
|
@ -33,18 +33,22 @@ M: quotation to-target-and-action
|
|||
[initWithTitle:action:keyEquivalent:] [autorelease] ;
|
||||
|
||||
: make-menu-item ( title spec -- item )
|
||||
to-target-and-action >r swap <NSMenuItem> dup r> [setTarget:] ;
|
||||
to-target-and-action >r swap <NSMenuItem> dup
|
||||
r> [setTarget:] ;
|
||||
|
||||
: submenu-to-item ( menu -- item )
|
||||
dup [title] CF>string f "" <NSMenuItem> dup rot [setSubmenu:] ;
|
||||
dup [title] CF>string f "" <NSMenuItem> dup
|
||||
rot [setSubmenu:] ;
|
||||
|
||||
: add-submenu ( menu submenu -- )
|
||||
submenu-to-item [addItem:] ;
|
||||
|
||||
: and-modifiers ( item key-equivalent-modifier-mask -- item )
|
||||
dupd [setKeyEquivalentModifierMask:] ;
|
||||
|
||||
: and-alternate ( item -- item )
|
||||
dup 1 [setAlternate:] ;
|
||||
|
||||
: and-option-equivalent-modifier 1572864 and-modifiers ;
|
||||
|
||||
! -------------------------------------------------------------------------
|
||||
|
@ -130,7 +134,6 @@ DEFER: described-menu
|
|||
{ "Paste and Match Style" "pasteAsPlainText:" "V" [ and-option-equivalent-modifier ] }
|
||||
{ "Delete" "delete:" "" }
|
||||
{ "Select All" "selectAll:" "a" }
|
||||
! { }
|
||||
! Find, Spelling, and Speech submenus go here
|
||||
} }
|
||||
{ {
|
||||
|
|
|
@ -0,0 +1,16 @@
|
|||
IN: cocoa
|
||||
USING: kernel sequences objc-NSPasteboard ;
|
||||
|
||||
: NSStringPboardType "NSStringPboardType" <NSString> ;
|
||||
|
||||
: pasteboard-type? ( type id -- seq )
|
||||
NSStringPboardType swap [types] CF>array member? ;
|
||||
|
||||
: pasteboard-string ( id -- str )
|
||||
NSStringPboardType [stringForType:] dup [ CF>string ] when ;
|
||||
|
||||
: set-pasteboard-types ( seq id -- )
|
||||
swap <NSArray> f [declareTypes:owner:] ;
|
||||
|
||||
: set-pasteboard-string ( str id -- )
|
||||
swap <NSString> NSStringPboardType [setString:forType:] ;
|
|
@ -0,0 +1,36 @@
|
|||
IN: objc-FactorServiceProvider
|
||||
DEFER: FactorServiceProvider
|
||||
|
||||
IN: cocoa
|
||||
USING: alien gadgets-presentations kernel objc
|
||||
objc-NSApplication objc-NSObject parser styles ;
|
||||
|
||||
: pasteboard-error ( error str -- f )
|
||||
"Pasteboard does not hold a string" <NSString>
|
||||
0 rot set-void*-nth f ;
|
||||
|
||||
: ?pasteboard-string ( pboard error -- str/f )
|
||||
NSStringPboardType pick pasteboard-type? [
|
||||
swap pasteboard-string [ ] [ pasteboard-error ] ?if
|
||||
] [
|
||||
nip pasteboard-error
|
||||
] if ;
|
||||
|
||||
: do-service ( pboard error quot -- | quot: str -- str/f )
|
||||
[
|
||||
>r ?pasteboard-string dup [ r> call ] [ r> 2drop ] if
|
||||
] keep over [ set-pasteboard-string ] [ 2drop ] if ;
|
||||
|
||||
"NSObject" "FactorServiceProvider" {
|
||||
{ "evalInListener:" "void" { "id" "SEL" "id" "id" "void*" }
|
||||
[ nip [ <input> f show-object f ] do-service ]
|
||||
}
|
||||
{ "evalToString:" "void" { "id" "SEL" "id" "id" "void*" }
|
||||
[ nip [ eval>string ] do-service ]
|
||||
}
|
||||
} { } define-objc-class
|
||||
|
||||
: register-services ( -- )
|
||||
NSApp
|
||||
FactorServiceProvider [alloc] [init]
|
||||
[setServicesProvider:] ;
|
|
@ -1,216 +1,32 @@
|
|||
! Copyright (C) 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: objc-FactorView
|
||||
DEFER: FactorView
|
||||
IN: objc-FactorUIWindowDelegate
|
||||
DEFER: FactorUIWindowDelegate
|
||||
IN: objc-FactorApplicationDelegate
|
||||
|
||||
USING: alien arrays cocoa errors freetype gadgets
|
||||
gadgets-launchpad gadgets-layouts gadgets-listener gadgets-panes
|
||||
hashtables kernel math namespaces objc objc-NSApplication
|
||||
objc-NSEvent objc-NSObject objc-NSOpenGLContext
|
||||
objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
|
||||
DEFER: FactorApplicationDelegate
|
||||
|
||||
! Cocoa backend for Factor UI
|
||||
IN: cocoa
|
||||
USING: gadgets-listener kernel objc objc-NSApplication
|
||||
objc-NSObject ;
|
||||
|
||||
IN: gadgets-cocoa
|
||||
: finder-run-files ( alien -- )
|
||||
CF>string-array listener-run-files
|
||||
NSApp NSApplicationDelegateReplySuccess
|
||||
[replyToOpenOrPrint:] ;
|
||||
|
||||
! Hash mapping aliens to gadgets
|
||||
SYMBOL: views
|
||||
|
||||
: reset-views ( hash -- hash ) H{ } clone views set-global ;
|
||||
|
||||
reset-views
|
||||
|
||||
: view ( handle -- world ) views get hash ;
|
||||
|
||||
: mouse-location ( view event -- loc )
|
||||
over >r
|
||||
[locationInWindow] f [convertPoint:fromView:]
|
||||
dup NSPoint-x swap NSPoint-y
|
||||
r> [frame] NSRect-h swap - 0 3array ;
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
over >r mouse-location r> view move-hand ;
|
||||
|
||||
: button ( event -- n )
|
||||
#! Cocoa -> Factor UI button mapping
|
||||
[buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
|
||||
|
||||
: button&loc ( view event -- button# loc )
|
||||
dup button -rot mouse-location ;
|
||||
|
||||
: modifiers
|
||||
{
|
||||
{ S+ HEX: 10000 }
|
||||
{ C+ HEX: 40000 }
|
||||
{ A+ HEX: 80000 }
|
||||
{ M+ HEX: 100000 }
|
||||
} ;
|
||||
|
||||
: key-codes
|
||||
H{
|
||||
{ 36 "RETURN" }
|
||||
{ 48 "TAB" }
|
||||
{ 51 "BACKSPACE" }
|
||||
{ 115 "HOME" }
|
||||
{ 117 "DELETE" }
|
||||
{ 119 "END" }
|
||||
{ 123 "LEFT" }
|
||||
{ 124 "RIGHT" }
|
||||
{ 125 "DOWN" }
|
||||
{ 126 "UP" }
|
||||
} ;
|
||||
|
||||
: key-code ( event -- string )
|
||||
dup [keyCode] key-codes hash
|
||||
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
|
||||
|
||||
: event>gesture ( event -- modifiers keycode )
|
||||
dup [modifierFlags] modifiers modifier swap key-code ;
|
||||
|
||||
: send-key-event ( view event quot -- )
|
||||
>r event>gesture r> call swap view world-focus
|
||||
handle-gesture ; inline
|
||||
|
||||
: send-user-input ( view event -- )
|
||||
[characters] CF>string swap view world-focus user-input ;
|
||||
|
||||
: send-key-down-event ( view event -- )
|
||||
2dup [ <key-down> ] send-key-event
|
||||
[ send-user-input ] [ 2drop ] if ;
|
||||
|
||||
: send-key-up-event ( view event -- )
|
||||
[ <key-up> ] send-key-event ;
|
||||
|
||||
: send-button-down$ ( view event -- )
|
||||
over >r button&loc r> view send-button-down ;
|
||||
|
||||
: send-button-up$ ( view event -- )
|
||||
over >r button&loc r> view send-button-up ;
|
||||
|
||||
: send-wheel$ ( view event -- )
|
||||
[ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
|
||||
|
||||
"NSOpenGLView" "FactorView" {
|
||||
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
|
||||
[ 2drop view draw-world ]
|
||||
}
|
||||
|
||||
{ "mouseMoved:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "mouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "mouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "mouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "scrollWheel:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-wheel$ ]
|
||||
}
|
||||
|
||||
{ "keyDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-key-down-event ]
|
||||
}
|
||||
|
||||
{ "keyUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-key-up-event ]
|
||||
}
|
||||
|
||||
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
|
||||
[ 2drop dup view-dim swap view set-gadget-dim ]
|
||||
}
|
||||
|
||||
{ "acceptsFirstResponder" "bool" { "id" "SEL" }
|
||||
[ 2drop 1 ]
|
||||
}
|
||||
|
||||
{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
|
||||
[
|
||||
rot drop
|
||||
SUPER-> [initWithFrame:pixelFormat:]
|
||||
dup "updateFactorGadgetSize:" add-resize-observer
|
||||
]
|
||||
}
|
||||
|
||||
{ "dealloc" "void" { "id" "SEL" }
|
||||
[
|
||||
drop
|
||||
dup view close-world
|
||||
dup views get remove-hash
|
||||
dup remove-observer
|
||||
SUPER-> [dealloc]
|
||||
]
|
||||
! Handle Open events from the Finder
|
||||
"NSObject" "FactorApplicationDelegate" {
|
||||
{ "application:openFiles:" "void" { "id" "SEL" "id" "id" }
|
||||
[ >r 3drop r> finder-run-files ]
|
||||
}
|
||||
} { } define-objc-class
|
||||
|
||||
: register-view ( world -- )
|
||||
dup world-handle views get set-hash ;
|
||||
|
||||
: <FactorView> ( gadget -- view )
|
||||
FactorView over rect-dim <GLView>
|
||||
[ over set-world-handle dup add-notify register-view ] keep ;
|
||||
|
||||
|
||||
: window-root-gadget-pref-dim [contentView] view pref-dim ;
|
||||
|
||||
: frame-rect-for-window-content-rect ( window rect -- rect )
|
||||
swap [styleMask] NSWindow -rot [frameRectForContentRect:styleMask:] ;
|
||||
|
||||
: content-rect-for-window-frame-rect ( window rect -- rect )
|
||||
swap [styleMask] NSWindow -rot [contentRectForFrameRect:styleMask:] ;
|
||||
|
||||
: window-content-rect ( window -- rect )
|
||||
dup [frame] content-rect-for-window-frame-rect ;
|
||||
|
||||
"NSObject" "FactorUIWindowDelegate" {
|
||||
{ "windowWillUseStandardFrame:defaultFrame:" "NSRect" { "id" "SEL" "id" "NSRect" }
|
||||
[
|
||||
drop 2nip
|
||||
dup window-content-rect NSRect-x-far-y
|
||||
pick window-root-gadget-pref-dim first2
|
||||
<far-y-NSRect>
|
||||
frame-rect-for-window-content-rect
|
||||
]
|
||||
}
|
||||
} { } define-objc-class
|
||||
|
||||
: install-window-delegate ( window -- )
|
||||
FactorUIWindowDelegate [alloc] [init] [setDelegate:] ;
|
||||
: install-app-delegate ( -- )
|
||||
NSApp
|
||||
FactorApplicationDelegate [alloc] [init] [setDelegate:] ;
|
||||
|
||||
IN: gadgets
|
||||
USING: errors freetype gadgets-cocoa objc-NSOpenGLContext
|
||||
objc-NSOpenGLView objc-NSView objc-NSWindow ;
|
||||
|
||||
: redraw-world ( handle -- )
|
||||
world-handle 1 [setNeedsDisplay:] ;
|
||||
|
@ -234,6 +50,7 @@ IN: shells
|
|||
] unless
|
||||
[
|
||||
[
|
||||
install-app-delegate
|
||||
reset-views
|
||||
reset-callbacks
|
||||
init-ui
|
||||
|
|
|
@ -1,8 +1,13 @@
|
|||
! Copyright (C) 2006 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: objc-FactorView
|
||||
DEFER: FactorView
|
||||
|
||||
IN: cocoa
|
||||
USING: arrays kernel objc-NSObject objc-NSOpenGLContext
|
||||
objc-NSOpenGLView objc-NSView opengl sequences ;
|
||||
USING: arrays gadgets gadgets-layouts hashtables kernel math
|
||||
namespaces objc objc-NSEvent objc-NSObject
|
||||
objc-NSOpenGLContext objc-NSOpenGLView objc-NSView opengl
|
||||
sequences ;
|
||||
|
||||
: <GLView> ( class dim -- view )
|
||||
>r [alloc] 0 0 r> first2 <NSRect>
|
||||
|
@ -18,3 +23,172 @@ objc-NSOpenGLView objc-NSView opengl sequences ;
|
|||
|
||||
: add-resize-observer ( view selector -- )
|
||||
NSViewFrameDidChangeNotification pick add-observer ;
|
||||
|
||||
! Hash mapping aliens to gadgets
|
||||
SYMBOL: views
|
||||
|
||||
: reset-views ( hash -- hash ) H{ } clone views set-global ;
|
||||
|
||||
reset-views
|
||||
|
||||
: view ( handle -- world ) views get hash ;
|
||||
|
||||
: mouse-location ( view event -- loc )
|
||||
over >r
|
||||
[locationInWindow] f [convertPoint:fromView:]
|
||||
dup NSPoint-x swap NSPoint-y
|
||||
r> [frame] NSRect-h swap - 0 3array ;
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
over >r mouse-location r> view move-hand ;
|
||||
|
||||
: button ( event -- n )
|
||||
#! Cocoa -> Factor UI button mapping
|
||||
[buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
|
||||
|
||||
: button&loc ( view event -- button# loc )
|
||||
dup button -rot mouse-location ;
|
||||
|
||||
: modifiers
|
||||
{
|
||||
{ S+ HEX: 10000 }
|
||||
{ C+ HEX: 40000 }
|
||||
{ A+ HEX: 80000 }
|
||||
{ M+ HEX: 100000 }
|
||||
} ;
|
||||
|
||||
: key-codes
|
||||
H{
|
||||
{ 36 "RETURN" }
|
||||
{ 48 "TAB" }
|
||||
{ 51 "BACKSPACE" }
|
||||
{ 115 "HOME" }
|
||||
{ 117 "DELETE" }
|
||||
{ 119 "END" }
|
||||
{ 123 "LEFT" }
|
||||
{ 124 "RIGHT" }
|
||||
{ 125 "DOWN" }
|
||||
{ 126 "UP" }
|
||||
} ;
|
||||
|
||||
: key-code ( event -- string )
|
||||
dup [keyCode] key-codes hash
|
||||
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
|
||||
|
||||
: event>gesture ( event -- modifiers keycode )
|
||||
dup [modifierFlags] modifiers modifier swap key-code ;
|
||||
|
||||
: send-key-event ( view event quot -- )
|
||||
>r event>gesture r> call swap view world-focus
|
||||
handle-gesture ; inline
|
||||
|
||||
: send-user-input ( view event -- )
|
||||
[characters] CF>string swap view world-focus user-input ;
|
||||
|
||||
: send-key-down-event ( view event -- )
|
||||
2dup [ <key-down> ] send-key-event
|
||||
[ send-user-input ] [ 2drop ] if ;
|
||||
|
||||
: send-key-up-event ( view event -- )
|
||||
[ <key-up> ] send-key-event ;
|
||||
|
||||
: send-button-down$ ( view event -- )
|
||||
over >r button&loc r> view send-button-down ;
|
||||
|
||||
: send-button-up$ ( view event -- )
|
||||
over >r button&loc r> view send-button-up ;
|
||||
|
||||
: send-wheel$ ( view event -- )
|
||||
[ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
|
||||
|
||||
"NSOpenGLView" "FactorView" {
|
||||
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
|
||||
[ 2drop view draw-world ]
|
||||
}
|
||||
|
||||
{ "mouseMoved:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "mouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-mouse-moved ]
|
||||
}
|
||||
|
||||
{ "mouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "mouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-down$ ]
|
||||
}
|
||||
|
||||
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-button-up$ ]
|
||||
}
|
||||
|
||||
{ "scrollWheel:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-wheel$ ]
|
||||
}
|
||||
|
||||
{ "keyDown:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-key-down-event ]
|
||||
}
|
||||
|
||||
{ "keyUp:" "void" { "id" "SEL" "id" }
|
||||
[ nip send-key-up-event ]
|
||||
}
|
||||
|
||||
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
|
||||
[ 2drop dup view-dim swap view set-gadget-dim ]
|
||||
}
|
||||
|
||||
{ "acceptsFirstResponder" "bool" { "id" "SEL" }
|
||||
[ 2drop 1 ]
|
||||
}
|
||||
|
||||
{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
|
||||
[
|
||||
rot drop
|
||||
SUPER-> [initWithFrame:pixelFormat:]
|
||||
dup "updateFactorGadgetSize:" add-resize-observer
|
||||
]
|
||||
}
|
||||
|
||||
{ "dealloc" "void" { "id" "SEL" }
|
||||
[
|
||||
drop
|
||||
dup view close-world
|
||||
dup views get remove-hash
|
||||
dup remove-observer
|
||||
SUPER-> [dealloc]
|
||||
]
|
||||
}
|
||||
} { } define-objc-class
|
||||
|
||||
: register-view ( world -- )
|
||||
dup world-handle views get set-hash ;
|
||||
|
||||
: <FactorView> ( gadget -- view )
|
||||
FactorView over rect-dim <GLView> [
|
||||
over set-world-handle dup add-notify register-view
|
||||
] keep ;
|
||||
|
|
|
@ -1,7 +1,11 @@
|
|||
! Copyright (C) 2006 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: objc-FactorWindowDelegate
|
||||
DEFER: FactorWindowDelegate
|
||||
|
||||
IN: cocoa
|
||||
USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
|
||||
USING: gadgets-layouts kernel math objc objc-NSObject
|
||||
objc-NSView objc-NSWindow sequences ;
|
||||
|
||||
: NSBorderlessWindowMask 0 ; inline
|
||||
: NSTitledWindowMask 1 ; inline
|
||||
|
@ -31,3 +35,33 @@ USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
|
|||
dup dup [contentView] [setInitialFirstResponder:]
|
||||
dup 1 [setAcceptsMouseMovedEvents:]
|
||||
dup f [makeKeyAndOrderFront:] ;
|
||||
|
||||
: window-root-gadget-pref-dim [contentView] view pref-dim ;
|
||||
|
||||
: frame-rect-for-window-content-rect ( window rect -- rect )
|
||||
swap [styleMask] NSWindow -rot
|
||||
[frameRectForContentRect:styleMask:] ;
|
||||
|
||||
: content-rect-for-window-frame-rect ( window rect -- rect )
|
||||
swap [styleMask] NSWindow -rot
|
||||
[contentRectForFrameRect:styleMask:] ;
|
||||
|
||||
: window-content-rect ( window -- rect )
|
||||
dup [frame] content-rect-for-window-frame-rect ;
|
||||
|
||||
"NSObject" "FactorWindowDelegate" {
|
||||
{
|
||||
"windowWillUseStandardFrame:defaultFrame:" "NSRect"
|
||||
{ "id" "SEL" "id" "NSRect" }
|
||||
[
|
||||
drop 2nip
|
||||
dup window-content-rect NSRect-x-far-y
|
||||
pick window-root-gadget-pref-dim first2
|
||||
<far-y-NSRect>
|
||||
frame-rect-for-window-content-rect
|
||||
]
|
||||
}
|
||||
} { } define-objc-class
|
||||
|
||||
: install-window-delegate ( window -- )
|
||||
FactorWindowDelegate [alloc] [init] [setDelegate:] ;
|
||||
|
|
|
@ -32,6 +32,9 @@ words ;
|
|||
|
||||
: try-run-file ( file -- ) [ [ run-file ] keep ] try drop ;
|
||||
|
||||
: eval>string ( str -- str )
|
||||
[ [ [ eval ] keep ] try drop ] string-out ;
|
||||
|
||||
: parse-resource ( path -- quot )
|
||||
dup parsing-file
|
||||
[ <resource-stream> "resource:" ] keep append parse-stream ;
|
||||
|
|
|
@ -55,9 +55,6 @@ parser prettyprint sequences strings words ;
|
|||
|
||||
: read-packet ( -- string ) 4 read be> read ;
|
||||
|
||||
: eval>string ( str -- )
|
||||
[ [ [ eval ] keep ] try drop ] string-out ;
|
||||
|
||||
: wire-server ( -- )
|
||||
#! Repeatedly read jEdit requests and execute them. Return
|
||||
#! on EOF.
|
||||
|
|
Loading…
Reference in New Issue