steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

x.factor additions 

Graphics context words
draw-lines word
darcs
wayo.cavazos 2006-02-17 01:48:02 +00:00
parent 9580a50945
commit 2b1716b559
1 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
contrib/x11/x.factor
View File

@ -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