Display gesture modifiers using Mac OS X Unicode characters
parent
9bf2675fa3
commit
f5d850f39e
|
@ -218,12 +218,10 @@ TUPLE: radio-control < button value ;
|
|||
align-left ; inline
|
||||
|
||||
M: radio-control model-changed
|
||||
swap value>>
|
||||
over value>> = >>selected?
|
||||
relayout-1 ;
|
||||
2dup [ value>> ] bi@ = >>selected? relayout-1 drop ;
|
||||
|
||||
: <radio-controls> ( assoc model parent quot: ( value model label -- gadget ) -- parent )
|
||||
'[ _ swap @ add-gadget ] assoc-each ; inline
|
||||
:: <radio-controls> ( parent model assoc quot: ( value model label -- gadget ) -- parent )
|
||||
assoc model [ parent swap quot call add-gadget ] assoc-each ; inline
|
||||
|
||||
: radio-button-theme ( gadget -- gadget )
|
||||
{ 5 5 } >>gap
|
||||
|
@ -234,7 +232,7 @@ M: radio-control model-changed
|
|||
|
||||
: <radio-buttons> ( model assoc -- gadget )
|
||||
<filled-pile>
|
||||
spin [ <radio-button> ] <radio-controls>
|
||||
[ <radio-button> ] <radio-controls>
|
||||
{ 5 5 } >>gap ;
|
||||
|
||||
: <toggle-button> ( value model label -- gadget )
|
||||
|
@ -242,7 +240,7 @@ M: radio-control model-changed
|
|||
|
||||
: <toggle-buttons> ( model assoc -- gadget )
|
||||
<shelf>
|
||||
spin [ <toggle-button> ] <radio-controls> ;
|
||||
[ <toggle-button> ] <radio-controls> ;
|
||||
|
||||
: command-button-quot ( target command -- quot )
|
||||
'[ _ _ invoke-command drop ] ;
|
||||
|
@ -252,8 +250,9 @@ M: radio-control model-changed
|
|||
|
||||
: <toolbar> ( target -- toolbar )
|
||||
<shelf>
|
||||
1 >>fill
|
||||
swap
|
||||
"toolbar" over class command-map commands>> swap
|
||||
[ [ "toolbar" ] dip class command-map commands>> ] keep
|
||||
'[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
|
||||
|
||||
: add-toolbar ( track -- track )
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
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
|
||||
alarms combinators sets columns fry deques ui.gadgets ;
|
||||
alarms combinators sets columns fry deques ui.gadgets
|
||||
unicode.case combinators.short-circuit ;
|
||||
IN: ui.gestures
|
||||
|
||||
GENERIC: handle-gesture ( gesture gadget -- ? )
|
||||
|
@ -280,12 +281,26 @@ SYMBOL: drag-timer
|
|||
|
||||
GENERIC: gesture>string ( gesture -- string/f )
|
||||
|
||||
: modifiers>string ( modifiers -- string )
|
||||
[ name>> ] map concat >string ;
|
||||
HOOK: modifiers>string os ( modifiers -- string )
|
||||
|
||||
M: macosx modifiers>string
|
||||
[
|
||||
{
|
||||
{ A+ [ "⌘" ] }
|
||||
{ M+ [ "⎇" ] }
|
||||
{ S+ [ "⇧" ] }
|
||||
{ C+ [ "⌃" ] }
|
||||
} case
|
||||
] map "" join ;
|
||||
|
||||
M: object modifiers>string
|
||||
[ name>> ] map "" join ;
|
||||
|
||||
M: key-down gesture>string
|
||||
dup mods>> modifiers>string
|
||||
swap sym>> append ;
|
||||
[ mods>> ] [ sym>> ] bi
|
||||
dup { [ length 1 = ] [ upper? ] } 1&&
|
||||
[ [ S+ prefix ] dip ] [ >upper ] if
|
||||
[ modifiers>string ] dip append ;
|
||||
|
||||
M: button-up gesture>string
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue