Multi-touch gestures

extra/ui/cocoa/views/views.factor

@@ -1,10 +1,10 @@
-! Copyright (C) 2006, 2007 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays assocs cocoa kernel math cocoa.messages
 cocoa.subclassing cocoa.classes cocoa.views cocoa.application
 cocoa.pasteboard cocoa.types cocoa.windows sequences ui
 ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
-threads ;
+threads combinators ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )
@@ -211,6 +211,42 @@ CLASS: {
     [ [ nip T{ select-all-action } send-action$ ] ui-try ]
 }
 
+! Multi-touch gestures: this is undocumented.
+! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html
+{ "magnifyWithEvent:" "void" { "id" "SEL" "id" }
+    [
+        nip
+        dup -> deltaZ sgn {
+            {  1 [ T{ zoom-in-action } send-action$ ] }
+            { -1 [ T{ zoom-out-action } send-action$ ] }
+            {  0 [ 2drop ] }
+        } case
+    ]
+}
+! 
+! { "rotateWithEvent:" "void" { "id" "SEL" "id" }
+!     [ "ROTATE" show ]
+! }
+
+{ "swipeWithEvent:" "void" { "id" "SEL" "id" }
+    [
+        nip
+        dup -> deltaX sgn {
+            {  1 [ T{ left-action } send-action$ ] }
+            { -1 [ T{ right-action } send-action$ ] }
+            {  0
+                [
+                    dup -> deltaY sgn {
+                        {  1 [ T{ up-action } send-action$ ] }
+                        { -1 [ T{ down-action } send-action$ ] }
+                        {  0 [ 2drop ] }
+                    } case
+                ]
+            }
+        } case
+    ]
+}
+
 { "acceptsFirstResponder" "bool" { "id" "SEL" }
     [ 2drop 1 ]
 }

extra/ui/gestures/gestures.factor

@@ -39,11 +39,19 @@ TUPLE: lose-focus ;         C: <lose-focus> lose-focus
 TUPLE: gain-focus ;         C: <gain-focus> gain-focus
 
 ! Higher-level actions
-TUPLE: cut-action ;        C: <cut-action> cut-action
-TUPLE: copy-action ;       C: <copy-action> copy-action
-TUPLE: paste-action ;      C: <paste-action> paste-action
-TUPLE: delete-action ;     C: <delete-action> delete-action
-TUPLE: select-all-action ; C: <select-all-action> select-all-action
+TUPLE: cut-action ;         C: <cut-action> cut-action
+TUPLE: copy-action ;        C: <copy-action> copy-action
+TUPLE: paste-action ;       C: <paste-action> paste-action
+TUPLE: delete-action ;      C: <delete-action> delete-action
+TUPLE: select-all-action ;  C: <select-all-action> select-all-action
+
+TUPLE: left-action ;        C: <left-action> left-action
+TUPLE: right-action ;       C: <right-action> right-action
+TUPLE: up-action ;          C: <up-action> up-action
+TUPLE: down-action ;        C: <down-action> down-action
+
+TUPLE: zoom-in-action ;  C: <zoom-in-action> zoom-in-action
+TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
 
 : generalize-gesture ( gesture -- newgesture )
     tuple>array 1 head* >tuple ;

extra/ui/tools/browser/browser.factor

@@ -76,3 +76,8 @@ browser-gadget "toolbar" f {
     { T{ key-down f { A+ } "v" } com-vocabularies }
     { T{ key-down f f "F1" } browser-help }
 } define-command-map
+
+browser-gadget "multi-touch" f {
+    { T{ left-action } com-back }
+    { T{ right-action } com-forward }
+} define-command-map

extra/ui/tools/inspector/inspector.factor

@@ -43,5 +43,9 @@ inspector-gadget "toolbar" f {
     { T{ key-down f f "F1" } inspector-help }
 } define-command-map
 
+inspector-gadget "multi-touch" f {
+    { T{ left-action } &back }
+} define-command-map
+
 M: inspector-gadget tool-scroller
     inspector-gadget-pane find-scroller ;

extra/ui/tools/tools.factor

@@ -70,6 +70,11 @@ workspace "tool-switching" f {
     { T{ key-down f { A+ } "4" } com-profiler }
 } define-command-map
 
+workspace "multi-touch" f {
+    { T{ zoom-out-action } com-listener }
+    { T{ up-action } refresh-all }
+} define-command-map
+
 \ workspace-window
 H{ { +nullary+ t } } define-command