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