basis/x11/windows/windows.factor

   1 ! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data kernel math
   4 math.bitwise math.vectors namespaces sequences arrays fry
   5 classes.struct literals x11 x11.xlib x11.constants x11.events
   6 x11.glx ;
   7 IN: x11.windows
   8
   9 CONSTANT: create-window-mask
  10     flags{ CWBackPixel CWBorderPixel CWColormap CWEventMask }
  11
  12 : create-colormap ( visinfo -- colormap )
  13     [ dpy get root get ] dip visual>> AllocNone
  14     XCreateColormap ;
  15
  16 CONSTANT: event-mask
  17     flags{
  18         ExposureMask
  19         StructureNotifyMask
  20         KeyPressMask
  21         KeyReleaseMask
  22         ButtonPressMask
  23         ButtonReleaseMask
  24         PointerMotionMask
  25         FocusChangeMask
  26         EnterWindowMask
  27         LeaveWindowMask
  28         PropertyChangeMask
  29     }
  30
  31 : window-attributes ( visinfo -- attributes )
  32     XSetWindowAttributes <struct>
  33     0 >>background_pixel
  34     0 >>border_pixel
  35     event-mask >>event_mask
  36     swap create-colormap >>colormap ;
  37
  38 : set-size-hints ( window -- )
  39     XSizeHints <struct>
  40     USPosition >>flags
  41     [ dpy get ] 2dip XSetWMNormalHints ;
  42
  43 : auto-position ( window loc -- )
  44     { 0 0 } = [ drop ] [ set-size-hints ] if ;
  45
  46 : >xy ( pair -- x y ) first2 [ >integer ] bi@ ;
  47
  48 : create-window ( loc dim visinfo -- window )
  49     pick [
  50         [ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
  51         [ depth>> InputOutput ] keep
  52         [ visual>> create-window-mask ] keep
  53         window-attributes XCreateWindow
  54         dup
  55     ] dip auto-position ;
  56
  57 : glx-window ( loc dim visual -- window glx )
  58     [ create-window ] [ create-glx ] bi ;
  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 visual -- glx pixmap glx-pixmap )
  76     [ nip create-glx ] [ create-glx-pixmap ] 2bi ;
  77
  78 : destroy-window ( win -- )
  79     dpy get swap XDestroyWindow drop ;
  80
  81 : set-closable ( win -- )
  82     dpy get swap XA_WM_DELETE_WINDOW Atom <ref> 1
  83     XSetWMProtocols drop ;
  84
  85 : map-window ( win -- ) dpy get swap XMapWindow drop ;
  86
  87 : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
  88
  89 : pixmap-bits ( dim pixmap -- alien )
  90     swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call
  91     [ XImage-pixels ] [ XDestroyImage drop ] bi ;