1 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types arrays hashtables io kernel math
4 math.order namespaces prettyprint sequences strings combinators
8 GENERIC: expose-event ( event window -- )
10 GENERIC: configure-event ( event window -- )
12 GENERIC: button-down-event ( event window -- )
14 GENERIC: button-up-event ( event window -- )
16 GENERIC: enter-event ( event window -- )
18 GENERIC: leave-event ( event window -- )
20 GENERIC: wheel-event ( event window -- )
22 GENERIC: motion-event ( event window -- )
24 GENERIC: key-down-event ( event window -- )
26 GENERIC: key-up-event ( event window -- )
28 GENERIC: focus-in-event ( event window -- )
30 GENERIC: focus-out-event ( event window -- )
32 GENERIC: selection-notify-event ( event window -- )
34 GENERIC: selection-request-event ( event window -- )
36 GENERIC: client-event ( event window -- )
38 : next-event ( -- event )
39 dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
41 : mask-event ( mask -- event )
42 [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
44 : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
46 : wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
48 : button-down-event$ ( event window -- )
49 over wheel? [ wheel-event ] [ button-down-event ] if ;
51 : button-up-event$ ( event window -- )
52 over wheel? [ 2drop ] [ button-up-event ] if ;
54 : handle-event ( event window -- )
56 { Expose [ expose-event ] }
57 { ConfigureNotify [ configure-event ] }
58 { ButtonPress [ button-down-event$ ] }
59 { ButtonRelease [ button-up-event$ ] }
60 { EnterNotify [ enter-event ] }
61 { LeaveNotify [ leave-event ] }
62 { MotionNotify [ motion-event ] }
63 { KeyPress [ key-down-event ] }
64 { KeyRelease [ key-up-event ] }
65 { FocusIn [ focus-in-event ] }
66 { FocusOut [ focus-out-event ] }
67 { SelectionNotify [ selection-notify-event ] }
68 { SelectionRequest [ selection-request-event ] }
69 { ClientMessage [ client-event ] }
73 : configured-loc ( event -- dim )
74 [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
76 : configured-dim ( event -- dim )
77 [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
79 : mouse-event-loc ( event -- loc )
80 [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
82 : close-box? ( event -- ? )
83 [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
84 [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]