diff --git a/library/cli.factor b/library/cli.factor index 31d2647c77..6f258c3934 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -39,6 +39,8 @@ parser sequences strings ; : cli-args ( -- args ) 10 getenv ; +: default-shell "tty" ; + : default-cli-args #! Some flags are *on* by default, unless user specifies #! -no- CLI switch @@ -46,7 +48,7 @@ parser sequences strings ; "compile" on "native-io" on "null-stdio" off - os "win32" = "ui" "tty" ? "shell" set ; + default-shell "shell" set ; : parse-command-line ( -- ) cli-args [ cli-arg ] subset [ try-run-file ] each ; diff --git a/library/cocoa/application-utils.factor b/library/cocoa/application-utils.factor index 9c88cc14de..7232de34f5 100644 --- a/library/cocoa/application-utils.factor +++ b/library/cocoa/application-utils.factor @@ -38,8 +38,3 @@ IN: errors : objc-error. ( alien -- ) "Objective C exception:" print [reason] CF>string print ; - -IN: gadgets - -: redraw-world ( gadgets -- ) - world-handle 1 [setNeedsDisplay:] ; diff --git a/library/cocoa/core-foundation.factor b/library/cocoa/core-foundation.factor index 4ff780c57e..b5563608fa 100644 --- a/library/cocoa/core-foundation.factor +++ b/library/cocoa/core-foundation.factor @@ -9,20 +9,26 @@ TYPEDEF: int CFIndex ! Core Foundation utilities -- will be moved elsewhere : kCFURLPOSIXPathStyle 0 ; -: kCFStringEncodingMacRoman 0 ; +: kCFStringEncodingUnicode HEX: 100 ; FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ; FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ; -FUNCTION: void* CFStringCreateWithCString ( void* allocator, char* cStr, int encoding ) ; +FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ; + +FUNCTION: void* CFStringCreateWithCString ( void* allocator, ushort* cStr, int encoding ) ; FUNCTION: CFIndex CFStringGetLength ( void* theString ) ; -FUNCTION: char* CFStringGetCStringPtr ( void* theString, int encoding ) ; +FUNCTION: ushort* CFStringGetCStringPtr ( void* theString, int encoding ) ; FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ; +FUNCTION: void* CFBundleGetMainBundle ( ) ; + +FUNCTION: void* CFBundleCopyExecutableURL ( void* bundle ) ; + FUNCTION: void* CFBundleGetFunctionPointerForName ( void* bundle, void* functionName ) ; FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ; @@ -30,10 +36,10 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ; FUNCTION: void CFRelease ( void* cf ) ; : ( string -- cf ) - f swap kCFStringEncodingMacRoman CFStringCreateWithCString ; + f swap kCFStringEncodingUnicode CFStringCreateWithCString ; : CF>string ( string -- string ) - kCFStringEncodingMacRoman CFStringGetCStringPtr ; + kCFStringEncodingUnicode CFStringGetCStringPtr ; : ( string dir? -- cf ) >r f over kCFURLPOSIXPathStyle @@ -53,3 +59,17 @@ FUNCTION: void CFRelease ( void* cf ) ; ] [ "Cannot load bundled named " swap append throw ] ?if ; + +: executable ( -- path ) + CFBundleGetMainBundle CFBundleCopyExecutableURL [ + kCFURLPOSIXPathStyle CFURLCopyFileSystemPath + [ CF>string ] keep CFRelease + ] keep CFRelease ; + +: running.app? ( -- ? ) + #! Test if we're running Factor.app. + executable "Contents/MacOS/Factor" tail? ; + +IN: kernel + +: default-shell running.app? "ui" "tty" ? ; diff --git a/library/cocoa/init-cocoa.factor b/library/cocoa/init-cocoa.factor index a6e7061203..4aaa0e755c 100644 --- a/library/cocoa/init-cocoa.factor +++ b/library/cocoa/init-cocoa.factor @@ -19,12 +19,11 @@ USING: cocoa compiler io kernel objc sequences words ; { "NSApplication" "NSAutoreleasePool" - "NSDate" "NSError" "NSEvent" "NSException" - "NSInvocation" - "NSMethodSignature" + "NSMenu" + "NSMenuItem" "NSObject" "NSOpenGLContext" "NSOpenGLView" diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index f4e49a19e4..1d36fd4817 100644 --- a/library/cocoa/ui.factor +++ b/library/cocoa/ui.factor @@ -1,9 +1,16 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. USING: alien arrays cocoa freetype gadgets gadgets-layouts -gadgets-listener io kernel namespaces objc objc-NSApplication -objc-NSObject objc-NSOpenGLContext objc-NSOpenGLView objc-NSView -objc-NSWindow opengl prettyprint sequences threads walker ; +gadgets-listener io kernel math namespaces objc +objc-NSApplication objc-NSEvent objc-NSMenu objc-NSObject +objc-NSOpenGLContext objc-NSOpenGLView objc-NSView objc-NSWindow +opengl prettyprint sequences threads walker ; + +IN: gadgets + +: redraw-world ( gadgets -- ) + world-handle [contentView] 1 [setNeedsDisplay:] ; + IN: gadgets-cocoa ! Cocoa backend for Factor UI @@ -30,6 +37,42 @@ IN: gadgets-cocoa [ [makeCurrentContext] call glFlush ] keep [flushBuffer] ; inline +: send-button-down ( event -- ) + update-clicked + [buttonNumber] dup hand get hand-buttons push + [ button-down ] button-gesture ; + +: send-button-up ( event -- ) + [buttonNumber] dup hand get hand-buttons delete + [ button-up ] button-gesture ; + +: mouse-location ( window -- loc ) + dup [contentView] [ + swap [mouseLocationOutsideOfEventStream] f + [convertPoint:fromView:] + dup NSPoint-x swap NSPoint-y + ] keep [frame] NSRect-h swap - 0 3array ; + +: send-mouse-moved ( -- ) + world get world-handle mouse-location move-hand ; + +: send-scroll-wheel ( event -- ) + [deltaY] 0 > + [ wheel-up ] [ wheel-down ] ? + hand get hand-clicked handle-gesture drop ; + +! M: key-down-event handle-event ( event -- ) +! dup keyboard-event>binding +! hand get hand-focus handle-gesture [ +! keyboard-event-unicode dup control? [ +! drop +! ] [ +! hand get hand-focus user-input drop +! ] if +! ] [ +! drop +! ] if ; + : init-FactorView-class "NSOpenGLView" "FactorView" { { "drawRect:" "void" { "id" "SEL" "NSRect" } @@ -41,11 +84,64 @@ IN: gadgets-cocoa ] } - { "reshape" "void" { "id" "SEL" } + { "mouseMoved:" "void" { "id" "SEL" "id" } + [ 3drop send-mouse-moved ] + } + + { "mouseDragged:" "void" { "id" "SEL" "id" } + [ 3drop send-mouse-moved ] + } + + { "rightMouseDragged:" "void" { "id" "SEL" "id" } + [ 3drop send-mouse-moved ] + } + + { "otherMouseDragged:" "void" { "id" "SEL" "id" } + [ 3drop send-mouse-moved ] + } + + { "mouseDown:" "void" { "id" "SEL" "id" } + [ 2nip send-button-down ] + } + + { "mouseUp:" "void" { "id" "SEL" "id" } + [ 2nip send-button-up ] + } + + { "rightMouseDown:" "void" { "id" "SEL" "id" } + [ 2nip send-button-down ] + } + + { "rightMouseUp:" "void" { "id" "SEL" "id" } + [ 2nip send-button-up ] + } + + { "otherMouseDown:" "void" { "id" "SEL" "id" } + [ 2nip send-button-down ] + } + + { "otherMouseUp:" "void" { "id" "SEL" "id" } + [ 2nip send-button-up ] + } + + { "scrollWheel:" "void" { "id" "SEL" "id" } + [ 2nip send-scroll-wheel ] + } + + { "keyDown:" "void" { "id" "SEL" "id" } [ - drop 1 [setNeedsDisplay:] + 2nip [characters] CF>string dup . flush + hand get hand-focus user-input drop ] } + + { "reshape" "void" { "id" "SEL" } + [ drop 1 [setNeedsDisplay:] ] + } + + { "acceptsFirstResponder" "bool" { "id" "SEL" } + [ 2drop 1 ] + } } { } define-objc-class ; parsing init-FactorView-class @@ -53,25 +149,36 @@ init-FactorView-class USE: objc-FactorView : ( gadget -- view ) + drop FactorView [alloc] 0 0 100 100 NSOpenGLView [defaultPixelFormat] - [initWithFrame:pixelFormat:] - [ swap set-world-handle ] keep ; + [initWithFrame:pixelFormat:] ; : ( gadget title -- window ) over rect-dim first2 0 0 2swap - [ swap [setContentView:] ] keep - dup f [makeKeyAndOrderFront:] ; + [ swap [setContentView:] ] 2keep + [ swap set-world-handle ] keep ; -[ +: ui [ - init-world - - world get ui-title - - [contentView] [openGLContext] [makeCurrentContext] - listener-application + [ + ! NSApplication NSMenu [alloc] [init] [setMainMenu:] + init-world - event-loop - ] with-cocoa -] with-freetype + world get ui-title + + dup 1 [setAcceptsMouseMovedEvents:] + + dup dup [contentView] [setInitialFirstResponder:] + + dup f [makeKeyAndOrderFront:] + + [contentView] [openGLContext] [makeCurrentContext] + listener-application + + NSApplication [sharedApplication] [finishLaunching] + event-loop + ] with-cocoa + ] with-freetype ; + +ui diff --git a/library/ui/editors.factor b/library/ui/editors.factor index 802589559f..6277d446c7 100644 --- a/library/ui/editors.factor +++ b/library/ui/editors.factor @@ -131,8 +131,8 @@ C: editor ( text -- ) : caret-dim ( editor -- w h ) rect-dim { 0 1 1 } v* { 1 0 0 } v+ ; -M: editor user-input* ( ch editor -- ? ) - [ insert-char ] with-editor f ; +M: editor user-input* ( str editor -- ? ) + [ insert-string ] with-editor f ; M: editor pref-dim* ( editor -- dim ) label-size { 1 0 0 } v+ ; diff --git a/library/ui/events.factor b/library/ui/events.factor deleted file mode 100644 index 1ca438c0d6..0000000000 --- a/library/ui/events.factor +++ /dev/null @@ -1,59 +0,0 @@ -! Copyright (C) 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: gadgets -USING: arrays alien gadgets-layouts generic kernel lists math -namespaces sequences strings freetype opengl ; - -GENERIC: handle-event ( event -- ) - -M: object handle-event ( event -- ) drop ; - -! : gl-resize ( event -- ) -! #! Acts on an SDL resize event. -! dup resize-event-w swap resize-event-h 0 gl-flags -! init-surface ; - -! : scroll-wheel? ( button -- ? ) { 4 5 } member? ; -! -! M: button-down-event handle-event ( event -- ) -! update-clicked button-event-button dup scroll-wheel? [ -! 4 = [ wheel-up ] [ wheel-down ] ? -! hand get hand-clicked handle-gesture drop -! ] [ -! dup hand get hand-buttons push -! [ button-down ] button-gesture -! ] if ; -! -! M: button-up-event handle-event ( event -- ) -! button-event-button dup scroll-wheel? [ -! dup hand get hand-buttons delete -! dup [ button-up ] button-gesture -! ] unless drop ; -! -! : motion-event-loc ( event -- loc ) -! dup motion-event-x swap motion-event-y 0 3array ; -! -! M: motion-event handle-event ( event -- ) -! motion-event-loc move-hand ; -! -! M: key-down-event handle-event ( event -- ) -! dup keyboard-event>binding -! hand get hand-focus handle-gesture [ -! keyboard-event-unicode dup control? [ -! drop -! ] [ -! hand get hand-focus user-input drop -! ] if -! ] [ -! drop -! ] if ; -! -! M: quit-event handle-event ( event -- ) -! drop stop-world ; -! -! M: resize-event handle-event ( event -- ) -! flush-fonts -! gl-resize -! world get remove-notify -! width get height get 0 3array world get set-gadget-dim -! world get add-notify ; diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index ab4942abfb..1b955db97c 100644 --- a/library/ui/gadgets.factor +++ b/library/ui/gadgets.factor @@ -59,7 +59,7 @@ C: gadget ( -- gadget ) : delegate>gadget ( tuple -- ) swap set-delegate ; -GENERIC: user-input* ( ch gadget -- ? ) +GENERIC: user-input* ( str gadget -- ? ) M: gadget user-input* 2drop t ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index eff930295d..3c1403aaab 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -26,7 +26,7 @@ USING: alien generic hashtables kernel lists math sequences ; #! gesture, otherwise returns f. [ dupd handle-gesture* ] each-parent nip ; -: user-input ( ch gadget -- ? ) +: user-input ( str gadget -- ? ) [ dupd user-input* ] each-parent nip ; ! Mouse gestures are lists where the first element is one of: diff --git a/library/ui/line-editor.factor b/library/ui/line-editor.factor index 6407e6e28f..04294c7eaa 100644 --- a/library/ui/line-editor.factor +++ b/library/ui/line-editor.factor @@ -103,9 +103,9 @@ M: document-elt prev-elt* 3drop 0 ; : delete-prev-elt ( element -- ) prev-elt@ line-remove ; -: insert-char ( ch -- ) +: insert-string ( str -- ) #! Call this in the line editor scope. - ch>string caret-pos dup line-replace ; + caret-pos dup line-replace ; : commit-history ( -- ) #! Call this in the line editor scope. Adds the currently diff --git a/library/ui/paint.factor b/library/ui/paint.factor index d5a514044b..f1e9767de1 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -19,6 +19,8 @@ SYMBOL: clip DEFER: draw-gadget +DEFER: world + : (draw-gadget) ( gadget -- ) dup rect-loc translate [ gl-translate diff --git a/library/win32/load.factor b/library/win32/load.factor index 06442461c3..3be22d611c 100644 --- a/library/win32/load.factor +++ b/library/win32/load.factor @@ -18,3 +18,7 @@ USING: alien io kernel parser sequences ; ] [ run-resource ] each + +IN: kernel + +: default-shell "ui" ;