Add horizontal scroll support
parent
c84ba1d76b
commit
84cd33357a
|
@ -93,8 +93,12 @@ M: world button-up-event
|
|||
send-button-up ;
|
||||
|
||||
: mouse-event>scroll-direction ( event -- pair )
|
||||
#! Reminder for myself: 4 is up, 5 is down
|
||||
XButtonEvent-button 5 = 1 -1 ? 0 swap 2array ;
|
||||
XButtonEvent-button {
|
||||
{ 4 { 0 -1 } }
|
||||
{ 5 { 0 1 } }
|
||||
{ 6 { -1 0 } }
|
||||
{ 7 { 1 0 } }
|
||||
} at ;
|
||||
|
||||
M: world wheel-event
|
||||
>r dup mouse-event>scroll-direction swap mouse-event-loc r>
|
||||
|
|
|
@ -42,7 +42,7 @@ GENERIC: client-event ( event window -- )
|
|||
|
||||
: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
|
||||
|
||||
: wheel? ( event -- ? ) XButtonEvent-button { 4 5 } member? ;
|
||||
: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
|
||||
|
||||
: button-down-event$ ( event window -- )
|
||||
over wheel? [ wheel-event ] [ button-down-event ] if ;
|
||||
|
|
Loading…
Reference in New Issue