extra/x11/events/events.factor

   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 namespaces prettyprint sequences strings combinators x11.xlib ;
   5 IN: x11.events
   6
   7 GENERIC: expose-event ( event window -- )
   8
   9 GENERIC: configure-event ( event window -- )
  10
  11 GENERIC: button-down-event ( event window -- )
  12
  13 GENERIC: button-up-event ( event window -- )
  14
  15 GENERIC: enter-event ( event window -- )
  16
  17 GENERIC: leave-event ( event window -- )
  18
  19 GENERIC: wheel-event ( event window -- )
  20
  21 GENERIC: motion-event ( event window -- )
  22
  23 GENERIC: key-down-event ( event window -- )
  24
  25 GENERIC: key-up-event ( event window -- )
  26
  27 GENERIC: focus-in-event ( event window -- )
  28
  29 GENERIC: focus-out-event ( event window -- )
  30
  31 GENERIC: selection-notify-event ( event window -- )
  32
  33 GENERIC: selection-request-event ( event window -- )
  34
  35 GENERIC: client-event ( event window -- )
  36
  37 : next-event ( -- event )
  38     dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
  39
  40 : mask-event ( mask -- event )
  41     >r dpy get r> "XEvent" <c-object> dup >r XMaskEvent drop r> ;
  42
  43 : events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
  44
  45 : wheel? ( event -- ? ) XButtonEvent-button { 4 5 } member? ;
  46
  47 : button-down-event$ ( event window -- )
  48     over wheel? [ wheel-event ] [ button-down-event ] if ;
  49
  50 : button-up-event$ ( event window -- )
  51     over wheel? [ 2drop ] [ button-up-event ] if ;
  52
  53 : handle-event ( event window -- )
  54     over XAnyEvent-type {
  55         { [ dup Expose = ] [ drop expose-event ] }
  56         { [ dup ConfigureNotify = ] [ drop configure-event ] }
  57         { [ dup ButtonPress = ] [ drop button-down-event$ ] }
  58         { [ dup ButtonRelease = ] [ drop button-up-event$ ] }
  59         { [ dup EnterNotify = ] [ drop enter-event ] }
  60         { [ dup LeaveNotify = ] [ drop leave-event ] }
  61         { [ dup MotionNotify = ] [ drop motion-event ] }
  62         { [ dup KeyPress = ] [ drop key-down-event ] }
  63         { [ dup KeyRelease = ] [ drop key-up-event ] }
  64         { [ dup FocusIn = ] [ drop focus-in-event ] }
  65         { [ dup FocusOut = ] [ drop focus-out-event ] }
  66         { [ dup SelectionNotify = ] [ drop selection-notify-event ] }
  67         { [ dup SelectionRequest = ] [ drop selection-request-event ] }
  68         { [ dup ClientMessage = ] [ drop client-event ] }
  69         { [ t ] [ 3drop ] }
  70     } cond ;
  71
  72 : configured-loc ( event -- dim )
  73     dup XConfigureEvent-x swap XConfigureEvent-y 2array ;
  74
  75 : configured-dim ( event -- dim )
  76     dup XConfigureEvent-width swap XConfigureEvent-height 2array ;
  77
  78 : mouse-event-loc ( event -- loc )
  79     dup XButtonEvent-x swap XButtonEvent-y 2array ;
  80
  81 : close-box? ( event -- ? )
  82     dup XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom =
  83     swap XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom =
  84     and ;