ui.gestures: Class vs word name duplication. Sorry for the lame names, this can get cleaned up with a tool once there are no more conflicts.

db4
Doug Coleman 2013-03-23 15:25:20 -07:00
parent d6053dd81e
commit 51e695857c
1 changed files with 12 additions and 12 deletions

View File

@ -33,50 +33,50 @@ M: object handles-gesture? ( gesture gadget -- ? )
GENERIC: send-queued-gesture ( request -- ) GENERIC: send-queued-gesture ( request -- )
TUPLE: send-gesture gesture gadget ; TUPLE: send-gesture-tuple gesture gadget ;
M: send-gesture send-queued-gesture M: send-gesture-tuple send-queued-gesture
[ gesture>> ] [ gadget>> ] bi handle-gesture drop ; [ gesture>> ] [ gadget>> ] bi handle-gesture drop ;
: queue-gesture ( ... class -- ) : queue-gesture ( ... class -- )
boa gesture-queue push-front notify-ui-thread ; inline boa gesture-queue push-front notify-ui-thread ; inline
: send-gesture ( gesture gadget -- ) : send-gesture ( gesture gadget -- )
\ send-gesture queue-gesture ; \ send-gesture-tuple queue-gesture ;
: each-gesture ( gesture seq -- ) [ send-gesture ] with each ; : each-gesture ( gesture seq -- ) [ send-gesture ] with each ;
TUPLE: propagate-gesture gesture gadget ; TUPLE: propagate-gesture-tuple gesture gadget ;
: resend-gesture ( gesture gadget -- ? ) : resend-gesture ( gesture gadget -- ? )
[ handle-gesture ] with each-parent ; [ handle-gesture ] with each-parent ;
M: propagate-gesture send-queued-gesture M: propagate-gesture-tuple send-queued-gesture
[ gesture>> ] [ gadget>> ] bi resend-gesture drop ; [ gesture>> ] [ gadget>> ] bi resend-gesture drop ;
: propagate-gesture ( gesture gadget -- ) : propagate-gesture ( gesture gadget -- )
\ propagate-gesture queue-gesture ; \ propagate-gesture-tuple queue-gesture ;
TUPLE: propagate-key-gesture gesture world ; TUPLE: propagate-key-gesture-tuple gesture world ;
: world-focus ( world -- gadget ) : world-focus ( world -- gadget )
dup focus>> [ world-focus ] [ ] ?if ; dup focus>> [ world-focus ] [ ] ?if ;
M: propagate-key-gesture send-queued-gesture M: propagate-key-gesture-tuple send-queued-gesture
[ gesture>> ] [ world>> world-focus ] bi [ gesture>> ] [ world>> world-focus ] bi
[ handle-gesture ] with each-parent drop ; [ handle-gesture ] with each-parent drop ;
: propagate-key-gesture ( gesture world -- ) : propagate-key-gesture ( gesture world -- )
\ propagate-key-gesture queue-gesture ; \ propagate-key-gesture-tuple queue-gesture ;
TUPLE: user-input string world ; TUPLE: user-input-tuple string world ;
M: user-input send-queued-gesture M: user-input-tuple send-queued-gesture
[ string>> ] [ world>> world-focus ] bi [ string>> ] [ world>> world-focus ] bi
[ user-input* ] with each-parent drop ; [ user-input* ] with each-parent drop ;
: user-input ( string world -- ) : user-input ( string world -- )
'[ _ \ user-input queue-gesture ] unless-empty ; '[ _ \ user-input-tuple queue-gesture ] unless-empty ;
! Gesture objects ! Gesture objects
TUPLE: drag # ; C: <drag> drag TUPLE: drag # ; C: <drag> drag