x.factor additions

Graphics context words
draw-lines word

contrib/x11/x.factor

@@ -1,5 +1,6 @@
 
-IN: x USING: namespaces kernel math arrays strings alien sequences xlib ;
+USING: namespaces kernel math arrays strings alien sequences xlib rectangle ;
+IN: x 
 
 SYMBOL: dpy
 SYMBOL: scr
@@ -147,6 +148,23 @@ DEFER: with-win
   dpy get colormap get r> dup >r XAllocColor drop
   r> XColor-pixel ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 7 - Graphics Context Functions
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: create-gc ( -- GC ) dpy get win get 0 0 <alien> XCreateGC ;
+
+: set-foreground ( foreground -- )
+dpy get gcontext get rot XSetForeground drop ;
+
+: set-background ( background -- )
+dpy get gcontext get rot XSetBackground drop ;
+
+: set-function ( function -- ) dpy get gcontext get rot XSetFunction drop ;
+
+: set-subwindow-mode ( subwindow-mode -- )
+dpy get gcontext get rot XSetSubwindowMode drop ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! 8 - Graphics Functions
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -159,6 +177,21 @@ DEFER: with-win
 : draw-line ( { x1 y1 } { x2 y2 } -- )
   >r >r dpy get win get gcontext get r> [ ] each r> [ ] each XDrawLine drop ;
 
+: 2nth ( i seq -- item-i item-i+1 ) 2dup nth -rot swap 1 + swap nth ;
+
+: draw-lines ( seq -- )
+dup length 1 - [ swap 2nth draw-line ] each-with ;
+
+: 4array 3array swap 1array swap append ;
+
+: 5array 4array swap 1array swap append ;
+
+: draw-rect ( rect -- )
+[ top-left ] keep [ top-right ] keep [ bottom-right ] keep
+[ bottom-left ] keep top-left 5array draw-lines ;
+
+: draw-rect+ [ draw-rect ] with-win ;
+
 ! 8.5 - Font Metrics
 
 : load-query-font ( name -- <XFontStruct> ) dpy get swap XLoadQueryFont ;
@@ -247,12 +280,16 @@ DEFER: with-win
 : destroy-window+		[ destroy-window ] with-win ;
 : map-window+			[ map-window ] with-win ;
 : unmap-window+			[ unmap-window ] with-win ;
+: valid-window?+		[ valid-window? ] with-win ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : with-dpy ( dpy quot -- ) [ swap dpy set call ] with-scope ; inline
 : with-win ( win quot -- ) [ swap win set call ] with-scope ; inline
 
+: with-gcontext ( gcontext quot -- )
+[ swap gcontext set call ] with-scope ; inline
+
 : initialize-x ( display-string -- )
   XOpenDisplay dpy set
   dpy get XDefaultScreen scr set