basis/x11/events/events.factor

   1 ! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays classes.struct combinators
   4 combinators.short-circuit kernel math.order namespaces x11 x11.X
   5 x11.xlib ;
   6 IN: x11.events
   7
   8 GENERIC: expose-event ( event window -- )
   9
  10 GENERIC: configure-event ( event window -- )
  11
  12 GENERIC: button-down-event ( event window -- )
  13
  14 GENERIC: button-up-event ( event window -- )
  15
  16 GENERIC: enter-event ( event window -- )
  17
  18 GENERIC: leave-event ( event window -- )
  19
  20 GENERIC: scroll-event ( event window -- )
  21
  22 GENERIC: motion-event ( event window -- )
  23
  24 GENERIC: key-down-event ( event window -- )
  25
  26 GENERIC: key-up-event ( event window -- )
  27
  28 GENERIC: focus-in-event ( event window -- )
  29
  30 GENERIC: focus-out-event ( event window -- )
  31
  32 GENERIC: selection-notify-event ( event window -- )
  33
  34 GENERIC: selection-request-event ( event window -- )
  35
  36 GENERIC: client-event ( event window -- )
  37
  38 : next-event ( -- event )
  39     dpy get XEvent new [ XNextEvent drop ] keep ;
  40
  41 : mask-event ( mask -- event )
  42     [ dpy get ] dip XEvent new [ XMaskEvent drop ] keep ;
  43
  44 : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
  45
  46 : mouse-scroll? ( event -- ? ) button>> 4 7 between? ;
  47
  48 : button-down-event$ ( event window -- )
  49     over mouse-scroll? [ scroll-event ] [ button-down-event ] if ;
  50
  51 : button-up-event$ ( event window -- )
  52     over mouse-scroll? [ 2drop ] [ button-up-event ] if ;
  53
  54 : handle-event ( event window -- )
  55     swap dup XAnyEvent>> type>> {
  56         { Expose [ XExposeEvent>> swap expose-event ] }
  57         { ConfigureNotify [ XConfigureEvent>> swap configure-event ] }
  58         { ButtonPress [ XButtonEvent>> swap button-down-event$ ] }
  59         { ButtonRelease [ XButtonEvent>> swap button-up-event$ ] }
  60         { EnterNotify [ XCrossingEvent>> swap enter-event ] }
  61         { LeaveNotify [ XCrossingEvent>> swap leave-event ] }
  62         { MotionNotify [ XMotionEvent>> swap motion-event ] }
  63         { KeyPress [ XKeyEvent>> swap key-down-event ] }
  64         { KeyRelease [ XKeyEvent>> swap key-up-event ] }
  65         { FocusIn [ XFocusChangeEvent>> swap focus-in-event ] }
  66         { FocusOut [ XFocusChangeEvent>> swap focus-out-event ] }
  67         { SelectionNotify [ XSelectionEvent>> swap selection-notify-event ] }
  68         { SelectionRequest [ XSelectionRequestEvent>> swap selection-request-event ] }
  69         { ClientMessage [ XClientMessageEvent>> swap client-event ] }
  70         [ 3drop ]
  71     } case ;
  72
  73 : event-loc ( event -- loc )
  74     [ x>> ] [ y>> ] bi 2array ;
  75
  76 : event-dim ( event -- dim )
  77     [ width>> ] [ height>> ] bi 2array ;
  78
  79 : XA_WM_PROTOCOLS ( -- atom ) "WM_PROTOCOLS" x-atom ;
  80 : XA_WM_DELETE_WINDOW ( -- atom ) "WM_DELETE_WINDOW" x-atom ;
  81
  82 : close-box? ( event -- ? )
  83     {
  84         [ message_type>> XA_WM_PROTOCOLS = ]
  85         [ data0>> XA_WM_DELETE_WINDOW = ]
  86     } 1&& ;