[ props>> ] [ default-flags swap assoc-union ] bi* update ;
: command-quot ( target command -- quot )
- dup 1quotation swap +nullary+ word-prop
+ [ 1quotation ] [ +nullary+ word-prop ] bi
[ nip ] [ curry ] if ;
M: word invoke-command ( target command -- )
[
command-name %
gesture>string [ " (" % % ")" % ] when*
- ] "" make ;
+ ] "" make ;
\ No newline at end of file
{ $command-map editor "editing" }
{ $command-map editor "caret-motion" }
{ $command-map editor "selection" }
+{ $command-map editor "clipboard" }
{ $command-map multiline-editor "multiline" } ;
ARTICLE: "ui.gadgets.editors" "Editor gadgets"
: com-cut ( editor -- ) clipboard get editor-cut ;
editor "clipboard" f {
- { paste-action com-paste }
- { copy-action com-copy }
{ cut-action com-cut }
- { T{ button-up f f 2 } paste-selection }
+ { copy-action com-copy }
+ { paste-action com-paste }
{ T{ button-up } com-copy-selection }
+ { T{ button-up f f 2 } paste-selection }
} define-command-map
: previous-character ( editor -- )
call namespaces opengl sequences io combinators
combinators.short-circuit fry math.vectors math.rectangles cache
ui.gadgets ui.gestures ui.render ui.text ui.text.private
-ui.backend ui.gadgets.tracks ;
+ui.backend ui.gadgets.tracks ui.commands ;
IN: ui.gadgets.worlds
TUPLE: world < track
] with-variable
] [ drop ] if ;
-world H{
- { T{ key-down f { C+ } "z" } [ undo-action send-action ] }
- { T{ key-down f { C+ } "Z" } [ redo-action send-action ] }
- { T{ key-down f { C+ } "x" } [ cut-action send-action ] }
- { T{ key-down f { C+ } "c" } [ copy-action send-action ] }
- { T{ key-down f { C+ } "v" } [ paste-action send-action ] }
- { T{ key-down f { C+ } "a" } [ select-all-action send-action ] }
+world
+action-gestures [
+ [ [ { C+ } ] dip f <key-down> ]
+ [ '[ _ send-action ] ]
+ bi*
+] H{ } assoc-map-as
+H{
{ T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
{ T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-up f { C+ } 1 } [ drop T{ button-up f f 3 } button-gesture ] }
{ T{ button-up f { A+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
{ T{ button-up f { M+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
-} set-gestures
+} assoc-union set-gestures
PREDICATE: specific-button-up < button-up #>> ;
PREDICATE: specific-button-down < button-down #>> ;
left-action right-action up-action down-action
zoom-in-action zoom-out-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 ;
+
+CONSTANT: action-gestures
+ {
+ { "z" undo-action }
+ { "Z" redo-action }
+ { "x" cut-action }
+ { "c" copy-action }
+ { "v" paste-action }
+ { "a" select-all-action }
+ }
+
! Modifiers
SYMBOLS: C+ A+ M+ S+ ;
M: zoom-out-action gesture>string drop "Zoom out (pinch)" ;
+HOOK: action-modifier os ( -- mod )
+
+M: object action-modifier C+ ;
+M: macosx action-modifier A+ ;
+
+M: action gesture>string
+ action-gestures value-at
+ action-modifier 1array
+ swap f <key-down> gesture>string ;
+
M: object gesture>string drop f ;