! Copyright (C) 2005, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel math math.order models
-namespaces make sequences words strings system hashtables math.parser
-math.vectors classes.tuple classes boxes calendar timers combinators
-sets columns fry deques ui.gadgets ui.gadgets.private ascii
-combinators.short-circuit ;
+USING: accessors arrays ascii assocs boxes calendar classes columns
+combinators combinators.short-circuit deques kernel make math
+math.order math.parser math.vectors namespaces sequences sets system
+timers ui.gadgets ui.gadgets.private words ;
IN: ui.gestures
: get-gesture-handler ( gesture gadget -- quot )
GENERIC: handles-gesture? ( gesture gadget -- ? )
-M: object handles-gesture? ( gesture gadget -- ? )
+M: object handles-gesture?
get-gesture-handler >boolean ;
: parents-handle-gesture? ( gesture gadget -- ? )
[ gesture>> ] [ world>> world-focus ] bi
[ handle-gesture ] with each-parent drop ;
-: propagate-key-gesture ( gesture world -- )
- \ propagate-key-gesture-tuple queue-gesture ;
+:: propagate-key-gesture ( gesture world -- )
+ world world-focus preedit? [
+ gesture world \ propagate-key-gesture-tuple queue-gesture
+ ] unless ;
TUPLE: user-input-tuple string world ;
TUPLE: drag # ; C: <drag> drag
TUPLE: button-up mods # ; C: <button-up> button-up
TUPLE: button-down mods # ; C: <button-down> button-down
+TUPLE: file-drop mods ; C: <file-drop> file-drop
+
+SYMBOL: dropped-files
SINGLETONS:
motion
revert-action close-action ;
UNION: action
-undo-action redo-action
-cut-action copy-action paste-action
-delete-action select-all-action
-left-action right-action up-action down-action
-zoom-in-action zoom-out-action
-new-action open-action save-action save-as-action
-revert-action close-action ;
+ undo-action redo-action
+ cut-action copy-action paste-action
+ delete-action select-all-action
+ left-action right-action up-action down-action
+ zoom-in-action zoom-out-action
+ new-action open-action save-action save-as-action
+ revert-action close-action ;
CONSTANT: action-gestures
{
TUPLE: key-down < key-gesture ;
-: new-key-gesture ( mods sym action? class -- mods' sym' )
+: new-key-gesture ( mods sym action? class -- key-gesture )
[ [ [ S+ swap remove f like ] dip ] unless ] dip boa ; inline
: <key-down> ( mods sym action? -- key-down )
M: macosx modifiers>string
[
{
- { A+ [ "\u002318" ] }
- { M+ [ "\u002325" ] }
+ { M+ [ "\u002318" ] }
+ { A+ [ "\u002325" ] }
{ S+ [ "\u0021e7" ] }
{ C+ [ "\u002303" ] }
} case
#>> [ " " % # ] when*
] "" make ;
+M: file-drop gesture>string drop "Drop files" ;
+
M: left-action gesture>string drop "Swipe left" ;
M: right-action gesture>string drop "Swipe right" ;
HOOK: action-modifier os ( -- mod )
M: object action-modifier C+ ;
-M: macosx action-modifier A+ ;
+M: macosx action-modifier M+ ;
M: action gesture>string
action-gestures value-at