From 75f809199471b2d723b7af6e16ec9e7afc4aae8f Mon Sep 17 00:00:00 2001 From: slava Date: Wed, 15 Mar 2006 05:24:00 +0000 Subject: [PATCH] Got Cocoa input events working --- TODO.FACTOR.txt | 2 + library/cocoa/core-foundation.factor | 15 ++++-- library/cocoa/ui.factor | 71 ++++++++++++++++++++------- library/collections/namespaces.factor | 2 - library/collections/namespaces.facts | 4 -- library/compiler/basic-blocks.factor | 2 + library/ui/world.factor | 2 +- 7 files changed, 67 insertions(+), 31 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index f75ca8c0c0..9d2306ba77 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -21,6 +21,7 @@ - autoload frameworks in cocoa class words - auto-define classes in obj-c class words - super message sends + super [foo]... + ui/help: @@ -42,6 +43,7 @@ + compiler/ffi: +- alien>utf16-string, utf16-string>alien words - float intrinsics - complex float type - complex float intrinsics diff --git a/library/cocoa/core-foundation.factor b/library/cocoa/core-foundation.factor index b5563608fa..7b45e80240 100644 --- a/library/cocoa/core-foundation.factor +++ b/library/cocoa/core-foundation.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. IN: cocoa -USING: alien arrays errors hashtables kernel namespaces +USING: alien arrays errors hashtables kernel math namespaces sequences ; TYPEDEF: int CFIndex @@ -9,6 +9,7 @@ TYPEDEF: int CFIndex ! Core Foundation utilities -- will be moved elsewhere : kCFURLPOSIXPathStyle 0 ; +: kCFStringEncodingMacRoman HEX: 0 ; : kCFStringEncodingUnicode HEX: 100 ; FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ; @@ -17,11 +18,13 @@ FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* bas FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ; -FUNCTION: void* CFStringCreateWithCString ( void* allocator, ushort* cStr, int encoding ) ; +FUNCTION: void* CFStringCreateWithCString ( void* allocator, char* cStr, int encoding ) ; FUNCTION: CFIndex CFStringGetLength ( void* theString ) ; -FUNCTION: ushort* CFStringGetCStringPtr ( void* theString, int encoding ) ; +FUNCTION: bool CFStringGetCString ( void* theString, void* buffer, CFIndex bufferSize, int encoding ) ; + +FUNCTION: CFIndex CFStringGetLength ( void* string ) ; FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ; @@ -36,10 +39,12 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ; FUNCTION: void CFRelease ( void* cf ) ; : ( string -- cf ) - f swap kCFStringEncodingUnicode CFStringCreateWithCString ; + f swap kCFStringEncodingMacRoman CFStringCreateWithCString ; : CF>string ( string -- string ) - kCFStringEncodingUnicode CFStringGetCStringPtr ; + dup CFStringGetLength 1+ dup [ + swap kCFStringEncodingMacRoman CFStringGetCString drop + ] keep alien>string ; : ( string dir? -- cf ) >r f over kCFURLPOSIXPathStyle diff --git a/library/cocoa/ui.factor b/library/cocoa/ui.factor index 1d36fd4817..7787793a92 100644 --- a/library/cocoa/ui.factor +++ b/library/cocoa/ui.factor @@ -1,7 +1,7 @@ ! 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 math namespaces objc +gadgets-listener hashtables io kernel lists math namespaces objc objc-NSApplication objc-NSEvent objc-NSMenu objc-NSObject objc-NSOpenGLContext objc-NSOpenGLView objc-NSView objc-NSWindow opengl prettyprint sequences threads walker ; @@ -37,13 +37,17 @@ IN: gadgets-cocoa [ [makeCurrentContext] call glFlush ] keep [flushBuffer] ; inline +: button ( event -- n ) + #! Cocoa -> Factor UI button mapping + [buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ; + : send-button-down ( event -- ) update-clicked - [buttonNumber] dup hand get hand-buttons push + button dup hand get hand-buttons push [ button-down ] button-gesture ; : send-button-up ( event -- ) - [buttonNumber] dup hand get hand-buttons delete + button dup hand get hand-buttons delete [ button-up ] button-gesture ; : mouse-location ( window -- loc ) @@ -61,17 +65,49 @@ IN: gadgets-cocoa [ 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 ; +: modifiers + { + { "SHIFT" HEX: 10000 } + { "CTRL" HEX: 40000 } + { "ALT" HEX: 80000 } + { "META" 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" } + } hash ; + +: modifier ( mod -- seq ) + modifiers + [ second swap bitand 0 > ] subset-with + [ first ] map ; + +: event>binding ( event -- binding ) + dup [modifierFlags] modifier swap [keyCode] key-codes + [ add >list ] [ drop f ] if* ; + +: send-user-input ( event -- ) + [characters] CF>string dup empty? + [ hand get hand-focus user-input ] unless drop ; + +: send-key-event ( event -- ) + dup event>binding + [ hand get hand-focus handle-gesture ] [ t ] if* + [ send-user-input ] [ drop ] if ; + +: resize-world ( world -- ) + dup world-handle [frame] dup NSRect-w swap NSRect-h 0 3array + swap set-gadget-dim ; : init-FactorView-class "NSOpenGLView" "FactorView" { @@ -129,14 +165,11 @@ IN: gadgets-cocoa } { "keyDown:" "void" { "id" "SEL" "id" } - [ - 2nip [characters] CF>string dup . flush - hand get hand-focus user-input drop - ] + [ 2nip send-key-event ] } { "reshape" "void" { "id" "SEL" } - [ drop 1 [setNeedsDisplay:] ] + [ ( 2drop world get resize-world ) ] } { "acceptsFirstResponder" "bool" { "id" "SEL" } diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor index ea0ea61a85..b950a3392a 100644 --- a/library/collections/namespaces.factor +++ b/library/collections/namespaces.factor @@ -47,8 +47,6 @@ SYMBOL: building : , ( obj -- ) building get push ; -: ?, ( obj ? -- ) [ , ] [ drop ] if ; - : % ( seq -- ) building get swap nappend ; : # ( n -- ) number>string % ; diff --git a/library/collections/namespaces.facts b/library/collections/namespaces.facts index 6cf71ce3de..cf476d92d9 100644 --- a/library/collections/namespaces.facts +++ b/library/collections/namespaces.facts @@ -96,10 +96,6 @@ HELP: , "( elt -- )" { $values { "elt" "an object" } } { $description "Adds an element to the end of the sequence being constructed by " { $link make } "." } ; -HELP: ?, "( elt ? -- )" -{ $values { "elt" "an object" } { ">" "a boolean indicating of the element should be added or not" } } -{ $description "Conditionally adds an element to the end of the sequence being constructed by " { $link make } "." } ; - HELP: % "( seq -- )" { $values { "seq" "a sequence" } } { $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ; diff --git a/library/compiler/basic-blocks.factor b/library/compiler/basic-blocks.factor index e84b18a4da..5abd56c0ee 100644 --- a/library/compiler/basic-blocks.factor +++ b/library/compiler/basic-blocks.factor @@ -106,6 +106,8 @@ GENERIC: trim-dead* ( tail vop -- ) M: tuple trim-dead* ( tail vop -- ) dup forget-vregs , drop ; +: ?, [ , ] [ drop ] if ; + : simplify-inc ( vop -- ) dup 0 vop-in zero? not ?, ; M: %inc-d trim-dead* ( tail vop -- ) simplify-inc drop ; diff --git a/library/ui/world.factor b/library/ui/world.factor index 71503af07c..82bb5bbfea 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -20,6 +20,7 @@ TUPLE: world glass status invalid timers handle ; C: world ( -- world ) over set-delegate + dup solid-interior t over set-gadget-root? H{ } clone over set-world-timers ; @@ -100,7 +101,6 @@ global [ first-time on ] bind global [ first-time get [ world set - world get solid-interior { 600 700 0 } world get set-gadget-dim hand set first-time off