Big set of Cocoa/UI changes

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-<flag> 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  ;

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:] ;

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 ) ;
 
 : <CFString> ( string -- cf )
-    f swap kCFStringEncodingMacRoman CFStringCreateWithCString ;
+    f swap kCFStringEncodingUnicode CFStringCreateWithCString ;
 
 : CF>string ( string -- string )
-    kCFStringEncodingMacRoman CFStringGetCStringPtr ;
+    kCFStringEncodingUnicode CFStringGetCStringPtr ;
 
 : <CFFileSystemURL> ( string dir? -- cf )
     >r <CFString> 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" ? ;

library/cocoa/init-cocoa.factor

@@ -19,12 +19,11 @@ USING: cocoa compiler io kernel objc sequences words ;
 {
     "NSApplication"
     "NSAutoreleasePool"
-    "NSDate"
     "NSError"
     "NSEvent"
     "NSException"
-    "NSInvocation"
+    "NSMenu"
-    "NSMethodSignature"
+    "NSMenuItem"
     "NSObject"
     "NSOpenGLContext"
     "NSOpenGLView"

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
+gadgets-listener io kernel math namespaces objc
-objc-NSObject objc-NSOpenGLContext objc-NSOpenGLView objc-NSView
+objc-NSApplication objc-NSEvent objc-NSMenu objc-NSObject
-objc-NSWindow opengl prettyprint sequences threads walker ;
+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
 
 : <FactorView> ( gadget -- view )
+    drop
     FactorView [alloc]
     0 0 100 100 <NSRect> NSOpenGLView [defaultPixelFormat]
-    [initWithFrame:pixelFormat:]
+    [initWithFrame:pixelFormat:] ;
-    [ swap set-world-handle ] keep ;
 
 : <FactorWindow> ( gadget title -- window )
     over rect-dim first2 0 0 2swap <NSRect> <NSWindow>
-    [ swap <FactorView> [setContentView:] ] keep
+    [ swap <FactorView> [setContentView:] ] 2keep
-    dup f [makeKeyAndOrderFront:] ;
+    [ swap set-world-handle ] keep ;
 
-[
+: ui
     [
-        init-world
+        [
+            ! NSApplication NSMenu [alloc] [init] [setMainMenu:]
+            init-world
         
-        world get ui-title <FactorWindow>
+            world get ui-title <FactorWindow>
     
-        [contentView] [openGLContext] [makeCurrentContext]
+            dup 1 [setAcceptsMouseMovedEvents:]
-        listener-application
     
-        event-loop
+            dup dup [contentView] [setInitialFirstResponder:]
-    ] with-cocoa
+    
-] with-freetype
+            dup f [makeKeyAndOrderFront:]
+    
+            [contentView] [openGLContext] [makeCurrentContext]
+            listener-application
+            
+            NSApplication [sharedApplication] [finishLaunching]
+            event-loop
+        ] with-cocoa
+    ] with-freetype ;
+
+ui

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 -- ? )
+M: editor user-input* ( str editor -- ? )
-    [ insert-char ] with-editor f ;
+    [ insert-string ] with-editor f ;
 
 M: editor pref-dim* ( editor -- dim )
     label-size { 1 0 0 } v+ ;

library/ui/events.factor

@@ -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 ;

library/ui/gadgets.factor

@@ -59,7 +59,7 @@ C: gadget ( -- gadget )
 
 : delegate>gadget ( tuple -- ) <gadget> swap set-delegate ;
 
-GENERIC: user-input* ( ch gadget -- ? )
+GENERIC: user-input* ( str gadget -- ? )
 
 M: gadget user-input* 2drop t ;
 

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:

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

library/ui/paint.factor

@@ -19,6 +19,8 @@ SYMBOL: clip
 
 DEFER: draw-gadget
 
+DEFER: world
+
 : (draw-gadget) ( gadget -- )
     dup rect-loc translate [
         gl-translate

library/win32/load.factor

@@ -18,3 +18,7 @@ USING: alien io kernel parser sequences ;
 ] [
     run-resource
 ] each
+
+IN: kernel
+
+: default-shell "ui" ;