Update X11 backend for gl-context backend words
parent
c69fadfc22
commit
5562310fdb
|
@ -1,13 +1,10 @@
|
||||||
IN: x11
|
IN: x11
|
||||||
USING: arrays freetype gadgets gadgets-launchpad
|
USING: arrays errors freetype gadgets gadgets-launchpad
|
||||||
gadgets-layouts gadgets-listener hashtables kernel
|
gadgets-layouts gadgets-listener hashtables kernel
|
||||||
kernel-internals math namespaces opengl sequences x11 ;
|
kernel-internals math namespaces opengl sequences x11 ;
|
||||||
|
|
||||||
: draw-glx-world ( world -- )
|
|
||||||
dup world-handle first2 [ draw-world ] with-glx-context ;
|
|
||||||
|
|
||||||
M: world handle-expose-event ( event world -- )
|
M: world handle-expose-event ( event world -- )
|
||||||
nip draw-glx-world ;
|
nip draw-world ;
|
||||||
|
|
||||||
M: world handle-resize-event ( event world -- )
|
M: world handle-resize-event ( event world -- )
|
||||||
>r
|
>r
|
||||||
|
@ -28,6 +25,13 @@ IN: gadgets
|
||||||
: in-window ( gadget status dim title -- )
|
: in-window ( gadget status dim title -- )
|
||||||
>r <world> r> drop gadget-window ;
|
>r <world> r> drop gadget-window ;
|
||||||
|
|
||||||
|
: select-gl-context ( handle -- )
|
||||||
|
second >r dpy get swap r> glXMakeCurrent
|
||||||
|
[ "Failed to set current GLX context" throw ] unless ;
|
||||||
|
|
||||||
|
: flush-gl-context ( handle -- )
|
||||||
|
dpy get swap first glXSwapBuffers ;
|
||||||
|
|
||||||
IN: shells
|
IN: shells
|
||||||
|
|
||||||
: ui ( -- )
|
: ui ( -- )
|
||||||
|
|
|
@ -105,16 +105,6 @@ SYMBOL: windows
|
||||||
>r dpy get r> f 1 glXCreateContext
|
>r dpy get r> f 1 glXCreateContext
|
||||||
[ "Failed to create GLX context" throw ] unless* ;
|
[ "Failed to create GLX context" throw ] unless* ;
|
||||||
|
|
||||||
: make-current ( win GLXContext -- )
|
|
||||||
>r dpy get swap r> glXMakeCurrent
|
|
||||||
[ "Failed to set current GLX context" throw ] unless ;
|
|
||||||
|
|
||||||
: swap-buffers ( win -- )
|
|
||||||
dpy get swap glXSwapBuffers ;
|
|
||||||
|
|
||||||
: with-glx-context ( win GLXContext quot -- )
|
|
||||||
pick >r >r make-current r> call r> swap-buffers ;
|
|
||||||
|
|
||||||
! Initialization
|
! Initialization
|
||||||
|
|
||||||
: check-display
|
: check-display
|
||||||
|
|
Loading…
Reference in New Issue