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: accessors kernel math math.bitwise math.vectors
   4 namespaces sequences x11 x11.xlib x11.constants x11.glx arrays
   5 fry classes.struct ;
   6 IN: x11.windows
   7
   8 CONSTANT: create-window-mask
   9     flags{ CWBackPixel CWBorderPixel CWColormap CWEventMask }
  10
  11 : create-colormap ( visinfo -- colormap )
  12     [ dpy get root get ] dip visual>> AllocNone
  13     XCreateColormap ;
  14
  15 CONSTANT: event-mask
  16     flags{
  17         ExposureMask
  18         StructureNotifyMask
  19         KeyPressMask
  20         KeyReleaseMask
  21         ButtonPressMask
  22         ButtonReleaseMask
  23         PointerMotionMask
  24         FocusChangeMask
  25         EnterWindowMask
  26         LeaveWindowMask
  27         PropertyChangeMask
  28     }
  29
  30 : window-attributes ( visinfo -- attributes )
  31     XSetWindowAttributes <struct>
  32     0 >>background_pixel
  33     0 >>border_pixel
  34     event-mask >>event_mask
  35     swap create-colormap >>colormap ;
  36
  37 : set-size-hints ( window -- )
  38     XSizeHints <struct>
  39     USPosition >>flags
  40     [ dpy get ] 2dip XSetWMNormalHints ;
  41
  42 : auto-position ( window loc -- )
  43     { 0 0 } = [ drop ] [ set-size-hints ] if ;
  44
  45 : >xy ( pair -- x y ) first2 [ >integer ] bi@ ;
  46
  47 : create-window ( loc dim visinfo -- window )
  48     pick [
  49         [ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
  50         [ depth>> InputOutput ] keep
  51         [ visual>> create-window-mask ] keep
  52         window-attributes XCreateWindow
  53         dup
  54     ] dip auto-position ;
  55
  56 : glx-window ( loc dim visual -- window glx )
  57     [ create-window ] [ create-glx ] bi ;
  58
  59 : create-pixmap ( dim visual -- pixmap )
  60     [ [ { 0 0 } swap ] dip create-window ] [
  61         drop [ dpy get ] 2dip first2 24 XCreatePixmap
  62         [ "Failed to create offscreen pixmap" throw ] unless*
  63     ] 2bi ;
  64
  65 : (create-glx-pixmap) ( pixmap visual -- pixmap glx-pixmap )
  66     [ drop ] [
  67         [ dpy get ] 2dip swap glXCreateGLXPixmap
  68         [ "Failed to create offscreen GLXPixmap" throw ] unless*
  69     ] 2bi ;
  70
  71 : create-glx-pixmap ( dim visual -- pixmap glx-pixmap )
  72     [ create-pixmap ] [ (create-glx-pixmap) ] bi ;
  73
  74 : glx-pixmap ( dim visual -- glx pixmap glx-pixmap )
  75     [ nip create-glx ] [ create-glx-pixmap ] 2bi ;
  76
  77 : destroy-window ( win -- )
  78     dpy get swap XDestroyWindow drop ;
  79
  80 : set-closable ( win -- )
  81     dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1
  82     XSetWMProtocols drop ;
  83
  84 : map-window ( win -- ) dpy get swap XMapWindow drop ;
  85
  86 : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
  87
  88 : pixmap-bits ( dim pixmap -- alien )
  89     swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call
  90     [ XImage-pixels ] [ XDestroyImage drop ] bi ;