basis/x11/windows/windows.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 hashtables kernel math math.vectors
   4 math.bitwise namespaces sequences x11.xlib x11.constants x11.glx ;
   5 IN: x11.windows
   6
   7 : create-window-mask ( -- n )
   8     { CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
   9
  10 : create-colormap ( visinfo -- colormap )
  11     dpy get root get rot XVisualInfo-visual AllocNone
  12     XCreateColormap ;
  13
  14 : event-mask ( -- n )
  15     {
  16         ExposureMask
  17         StructureNotifyMask
  18         KeyPressMask
  19         KeyReleaseMask
  20         ButtonPressMask
  21         ButtonReleaseMask
  22         PointerMotionMask
  23         FocusChangeMask
  24         EnterWindowMask
  25         LeaveWindowMask
  26         PropertyChangeMask
  27     } flags ;
  28
  29 : window-attributes ( visinfo -- attributes )
  30     "XSetWindowAttributes" <c-object>
  31     0 over set-XSetWindowAttributes-background_pixel
  32     0 over set-XSetWindowAttributes-border_pixel
  33     [ >r create-colormap r> set-XSetWindowAttributes-colormap ] keep
  34     event-mask over set-XSetWindowAttributes-event_mask ;
  35
  36 : set-size-hints ( window -- )
  37     "XSizeHints" <c-object>
  38     USPosition over set-XSizeHints-flags
  39     dpy get -rot XSetWMNormalHints ;
  40
  41 : auto-position ( window loc -- )
  42     { 0 0 } = [ drop ] [ set-size-hints ] if ;
  43
  44 : create-window ( loc dim visinfo -- window )
  45     pick >r
  46     >r >r >r dpy get root get r> first2 r> { 1 1 } vmax first2 0 r>
  47     [ XVisualInfo-depth InputOutput ] keep
  48     [ XVisualInfo-visual create-window-mask ] keep
  49     window-attributes XCreateWindow
  50     dup r> auto-position ;
  51
  52 : glx-window ( loc dim -- window glx )
  53     choose-visual
  54     [ create-window ] keep
  55     [ create-glx ] keep
  56     XFree ;
  57
  58 : destroy-window ( win -- )
  59     dpy get swap XDestroyWindow drop ;
  60
  61 : set-closable ( win -- )
  62     dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1
  63     XSetWMProtocols drop ;
  64
  65 : map-window ( win -- ) dpy get swap XMapWindow drop ;
  66
  67 : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;