X11 UI backend is close to working

TODO.FACTOR.txt

@@ -29,6 +29,10 @@
 
 + ui/help:
 
+- speed up ideas:
+  - only do clipping for certain gadgets
+  - use glRect
+  - display lists
 - add some padding to launchpad ui
 - saving the image should save window configuration
 - menu drag retarget broken
@@ -47,8 +51,7 @@
 - document tools
 - document conventions
 - new turtle graphics tutorial
-- better line spacing in ui and html
+- better line spacing in ui and html=
-- use vertex arrays and display lists to speed up ui
 - tabular formatting - for inspector and changes
 - don't multiplex in the event loop if there is no pending i/o
 

library/bootstrap/boot-stage2.factor

@@ -10,7 +10,7 @@ recrossref
 
 "compile" get [
     "native-io" get [
-        os { "freebsd" "linux" "macosx" "solaris" } member? [
+        unix? [
             "/library/unix/load.factor" run-resource
         ] when
 

library/cli.factor

@@ -49,6 +49,7 @@ parser sequences strings ;
     "native-io" on
     "null-stdio" off
     os "macosx" = "cocoa" set
+    unix? os "macosx" = not and "x11" set
     default-shell "shell" set ;
 
 : parse-command-line ( -- )

library/collections/sequences-epilogue.factor

@@ -139,3 +139,5 @@ M: object <=>
 : with-datastack ( stack word -- stack )
     datastack >r >r set-datastack r> execute
     datastack r> [ push ] keep set-datastack 2nip ;
+
+: unix? os { "freebsd" "linux" "macosx" "solaris" } member? ;

library/ui/hand.factor

@@ -12,6 +12,7 @@ queues sequences ;
 ! the gadget in question.
 SYMBOL: hand-gadget
 SYMBOL: hand-loc
+{ 0 0 0 } hand-loc set-global
 
 SYMBOL: hand-clicked
 SYMBOL: hand-click-loc

library/x11/ui.factor

@@ -1,59 +1,44 @@
-USING: alien kernel math namespaces opengl threads x11 ;
+IN: x11
+USING: arrays freetype gadgets gadgets-launchpad
+gadgets-layouts gadgets-listener hashtables kernel
+kernel-internals math namespaces opengl sequences x11 ;
 
-f initialize-x
+: draw-glx-world ( world -- )
+    dup world-handle first2 [ draw-world ] with-glx-context ;
 
-SYMBOL: window
+M: world handle-expose-event ( event world -- )
+    nip draw-glx-world ;
 
-choose-visual
+M: world handle-resize-event ( event world -- )
+    >r
+    dup XConfigureEvent-width swap XConfigureEvent-height 0
+    3array
+    r> set-gadget-dim ;
 
-500 500 pick create-window window set
+: gadget-window ( world -- window )
+    dup rect-dim first2 choose-visual [
+        create-window 2dup windows get set-hash dup map-window
+    ] keep create-context 2array swap set-world-handle ;
 
-window get map-window
+IN: gadgets
 
-create-context window get swap make-current
+: repaint-handle ( handle -- )
+    drop ; ! windows get hash draw-glx-world ;
 
-SYMBOL: pval
+: in-window ( gadget status dim title -- )
+    >r <world> r> drop gadget-window ;
 
-:  p pval get ;
+IN: shells
-: -p pval get neg ;
 
-: wire-cube ( size -- )
+: ui ( -- )
-    2.0 / pval set
+    [
-    GL_LINE_LOOP glBegin
+        f [
-    -p -p -p glVertex3f
+            launchpad-window
-     p -p -p glVertex3f
+            listener-window
-     p  p -p glVertex3f
+            event-loop
-    -p  p -p glVertex3f
+        ] with-x
-    glEnd
+    ] with-freetype ;
-    GL_LINE_LOOP glBegin
-    -p -p  p glVertex3f
-     p -p  p glVertex3f
-     p  p  p glVertex3f
-    -p  p  p glVertex3f
-    glEnd
-    GL_LINES glBegin
-    -p -p -p glVertex3f
-    -p -p  p glVertex3f
-     p -p -p glVertex3f
-     p -p  p glVertex3f
-    -p  p -p glVertex3f
-    -p  p  p glVertex3f
-     p  p -p glVertex3f
-     p  p  p glVertex3f
-    glEnd ;
 
-: display ( -- )
+IN: kernel
-    0.0 0.0 0.0 0.0 glClearColor GL_FLAT glShadeModel
-    GL_COLOR_BUFFER_BIT glClear
-    1.0 1.0 1.0 glColor3f
-    glLoadIdentity
-    0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0 gluLookAt
-    1.0 2.0 1.0 glScalef
-    1.0 wire-cube
-    glFlush ;
 
-display
+! : default-shell "DISPLAY" getenv empty? "tty" "ui" ? ;
-
-window get swap-buffers
-
-flush-dpy

library/x11/utilities.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: x11
-USING: alien arrays errors io kernel math namespaces prettyprint
+USING: alien arrays errors gadgets hashtables io kernel math
-sequences threads ;
+namespaces prettyprint sequences threads ;
 
 SYMBOL: dpy
 SYMBOL: scr
@@ -66,14 +66,28 @@ SYMBOL: root
     dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
 
 : wait-event ( -- event )
-      QueuedAfterFlush events-queued 0 >
+    QueuedAfterFlush events-queued 0 > [
-      [ next-event ] [ 10 sleep wait-event ] if ;
+        next-event
+    ] [
+        do-timers layout-queued 10 sleep wait-event
+    ] if ;
 
-: handle-event ( event -- )
+GENERIC: handle-expose-event ( event window -- )
-    XAnyEvent-type . flush ;
+
+GENERIC: handle-resize-event ( event window -- )
+
+: handle-event ( event window -- )
+    over XAnyEvent-type {
+        { [ dup Expose = ] [ drop handle-expose-event ] }
+        { [ dup ConfigureNotify = ] [ drop handle-resize-event ] }
+        { [ t ] [ 3drop ] }
+    } cond ;
+
+SYMBOL: windows
 
 : event-loop ( -- )
-    wait-event handle-event event-loop ;
+    wait-event dup XAnyEvent-window windows get hash dup
+    [ handle-event ] [ 2drop ] if event-loop ;
 
 ! GLX
 
@@ -98,19 +112,22 @@ SYMBOL: root
 : swap-buffers ( win -- )
     dpy get swap glXSwapBuffers ;
 
+: with-glx-context ( win GLXContext quot -- )
+    pick >r >r make-current r> call r> swap-buffers ;
+
 ! Initialization
 
 : check-display
     [ "Cannot connect to X server - check $DISPLAY" throw ] unless* ;
 
-: (initialize-x) ( display-string -- )
+: initialize-x ( display-string -- )
     XOpenDisplay check-display dpy set
     dpy get XDefaultScreen scr set
     dpy get scr get XRootWindow root set ;
 
-: initialize-x ( display-string -- )
+: with-x ( display-string quot -- )
-    dpy get [
+    [
-        drop
+        H{ } clone windows set
-    ] [
+        swap initialize-x
-        (initialize-x) [ event-loop ] in-thread
+        call
-    ] if ;
+    ] with-scope ;