steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add horizontal scroll support

release
Slava Pestov 2007-10-10 02:16:42 -04:00
parent c84ba1d76b
commit 84cd33357a
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/ui/x11/x11.factor
View File

@ -93,8 +93,12 @@ M: world button-up-event
send-button-up ; send-button-up ;
: mouse-event>scroll-direction ( event -- pair ) : mouse-event>scroll-direction ( event -- pair )
#! Reminder for myself: 4 is up, 5 is down XButtonEvent-button {
XButtonEvent-button 5 = 1 -1 ? 0 swap 2array ; { 4 { 0 -1 } }
{ 5 { 0 1 } }
{ 6 { -1 0 } }
{ 7 { 1 0 } }
} at ;
M: world wheel-event M: world wheel-event
>r dup mouse-event>scroll-direction swap mouse-event-loc r> >r dup mouse-event>scroll-direction swap mouse-event-loc r>

2
extra/x11/events/events.factor
View File

@ -42,7 +42,7 @@ GENERIC: client-event ( event window -- )
: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ; : 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 -- ) : button-down-event$ ( event window -- )
over wheel? [ wheel-event ] [ button-down-event ] if ; over wheel? [ wheel-event ] [ button-down-event ] if ;