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

Added some examples 

Added the beginning of a framework for concurrent widgets
Beefed up xlib with some more constants and event definitions
Improved x.factor
cvs
Eduardo Cavazos 2005-11-12 11:25:58 +00:00
parent 645a17b27f
commit 16454ccb99
7 changed files with 433 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
contrib/x11/concurrent-widgets.factor Normal file
View File

@ -0,0 +1,119 @@
IN: concurrent-widgets
USING: namespaces kernel hashtables math generic threads concurrency xlib x ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: window display id ;
! dpy get create-window <window>
! window-object [ { 100 100 } move-window ] with-window-object
: create-window-object
dpy get create-window <window> ;
: with-window-object ( <window> quot -- )
[ swap dup window-display dpy set window-id win set call ] with-scope ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! window-table add-to-window-table
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: window-table
10 <hashtable> window-table set
: add-to-window-table ( <window> -- )
dup window-id window-table get set-hash ;
! The window-table is keyed on window ids. If support is added for
! multiple displays, then perhaps there should be a window table for
! each open display.
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! handle-event
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: handle-key-press-event
GENERIC: handle-key-release-event
GENERIC: handle-button-press-event
GENERIC: handle-button-release-event
GENERIC: handle-expose-event
: handle-event ( event obj -- )
over XAnyEvent-type
dup KeyPress = [ handle-key-press-event ] when
dup KeyRelease = [ handle-key-release-event ] when
dup ButtonPress = [ drop handle-button-press-event ] when
dup ButtonRelease = [ handle-button-release-event ] when
dup Expose = [ drop handle-expose-event ] when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: label text ;
: create-label ( text -- <label> )
>r create-window-object r> <label> dup >r set-delegate r>
dup add-to-window-table
dup >r
>r ExposureMask r> [ select-input ] with-window-object
r> ;
M: label handle-expose-event ( event <label> -- )
swap drop >r
gcontext get { 10 10 } r> dup >r label-text
r> [ draw-string ] with-window-object ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: button action ;
: create-button ( text action -- <button> )
swap create-label swap <button> dup >r set-delegate r>
dup add-to-window-table
>r ExposureMask ButtonPressMask bitor r>
dup >r [ select-input ] with-window-object
r> ;
M: button handle-button-press-event ( event <button> -- )
swap drop button-action call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! event-loop
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : event-loop ( -- )
! next-event ! event
! dup ! event event
! XAnyEvent-window ! event window
! window-table get ! event window table
! hash ! event obj-or-f
! dup ! event obj-or-f obj-or-f
! [ handle-event ]
! [ drop drop ] ! event obj-or-f obj-or-f [ handle-event ] [ drop drop ]
! ifte
! event-loop ;
! It's possible to have multiple displays open simultaneously.
! Maybe there can be an event loop for each display. Each event loop
! would run in it's own thread.
: concurrent-next-event ( -- event )
! QueuedAlready events-queued 0 >
QueuedAfterFlush events-queued 0 >
[ next-event ]
[ 100 sleep concurrent-next-event ]
ifte ;
: concurrent-event-loop ( -- )
concurrent-next-event ! event
dup ! event event
XAnyEvent-window ! event window
window-table get ! event window table
hash ! event obj-or-f
dup ! event obj-or-f obj-or-f
[ handle-event ]
[ drop drop ] ! event obj-or-f obj-or-f [ handle-event ] [ drop drop ]
ifte
concurrent-event-loop ;

12
contrib/x11/example-01.factor Normal file
View File

@ -0,0 +1,12 @@
USING: io concurrency x concurrent-widgets ;
f initialize-x
"Hey Hey" create-label
[ map-window ] with-window-object
"Yo Yo Yo" [ "button pressed" print ] create-button
[ map-window ] with-window-object
[ concurrent-event-loop ] spawn

48
contrib/x11/example-02.factor Normal file
View File

@ -0,0 +1,48 @@
USING: kernel namespaces sequences x concurrency concurrent-widgets ;
SYMBOL: win-a SYMBOL: win-b SYMBOL: win-c SYMBOL: win-d
f initialize-x
[ win-a win-b win-c win-d ] [ create-window swap set ] each
[ win-a win-b win-c win-d ] [ "black" "red" "green" "blue" ]
[ lookup-color swap get win set set-window-background ] 2each
[ win-b win-c win-d ] [ get win set win-a get reparent-window ] each
[ win-a win-b win-c win-d ] [ get win set map-window ] each
win-a get [ { 300 300 } resize-window ] with-win
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: button-horizontal
"Horizontal"
[ win-a get
[ stack-children arrange-children-horizontally ] with-win
] create-button
button-horizontal set
button-horizontal get
[ { 100 20 } resize-window
map-window
] with-window-object
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: button-vertical
"Vertical"
[ win-a get
[ stack-children arrange-children-vertically ] with-win
] create-button
button-vertical set
button-vertical get
[ { 100 20 } resize-window
map-window
] with-window-object
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[ concurrent-event-loop ] spawn

38
contrib/x11/example-03.factor Normal file
View File

@ -0,0 +1,38 @@
USING: kernel namespaces sequences io xlib x concurrency concurrent-widgets ;
SYMBOL: win-a
SYMBOL: button-a
SYMBOL: button-b
SYMBOL: button-c
f initialize-x
create-window-object win-a set
win-a get [ "black" lookup-color set-window-background ] with-window-object
"Hey Hey Hey" [ "button pressed" print ] create-button button-a set
"Yo Yo Yo" [ "button pressed" print ] create-button button-b set
"Foo" [ "button pressed" print ] create-button button-c set
[ button-a button-b button-c ] [ "red" "green" "blue" ]
[ lookup-color swap get [ set-window-background ] with-window-object ]
2each
[ button-a button-b button-c ]
[ get [ { 100 20 } resize-window ] with-window-object ]
each
[ button-a button-b button-c ]
[ get [ win-a get window-id reparent-window ] with-window-object ]
each
win-a get [ map-window ] with-window-object
[ button-a button-b button-c ] [ get [ map-window ] with-window-object ]
each
win-a get [ arrange-children-vertically ] with-window-object
[ concurrent-event-loop ] spawn

8
contrib/x11/load.factor Normal file
View File

@ -0,0 +1,8 @@
USING: kernel parser words compiler sequences ;
"./xlib.factor" run-file
"xlib" words [ try-compile ] each
clear
"./x.factor" run-file

83
contrib/x11/x.factor
View File

@ -1,5 +1,5 @@
IN: x USING: namespaces kernel sequences xlib ;
IN: x USING: namespaces kernel math vectors alien sequences xlib ;
SYMBOL: dpy
SYMBOL: scr
@ -8,6 +8,14 @@ SYMBOL: gcontext
SYMBOL: win
SYMBOL: black-pixel
SYMBOL: white-pixel
SYMBOL: colormap
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: <ulong> <uint> ;
: <XID> <ulong> ;
: <Window> <XID> ;
: <Drawable> <XID> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 3.3 - Creating Windows
@ -20,7 +28,7 @@ SYMBOL: white-pixel
! arguments.
: create-window ( -- win )
dpy get root get 0 0 100 100 10 black-pixel get white-pixel get
dpy get root get 0 0 100 100 0 black-pixel get white-pixel get
XCreateSimpleWindow ;
: destroy-window ( -- ) dpy get win get XDestroyWindow drop ;
@ -33,6 +41,10 @@ SYMBOL: white-pixel
: move-window ( { x y } -- ) >r dpy get win get r> [ ] each XMoveWindow drop ;
: set-window-x ( x -- ) 0 window-position dup >r set-nth r> move-window ;
: set-window-y ( y -- ) 1 window-position dup >r set-nth r> move-window ;
: resize-window ( { width height } -- )
>r dpy get win get r> [ ] each XResizeWindow drop ;
@ -41,6 +53,29 @@ SYMBOL: white-pixel
: raise-window ( -- ) dpy get win get XRaiseWindow drop ;
: lower-window ( -- ) dpy get win get XLowerWindow drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 4 - Window Information Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: window-size ( -- { width height } )
dpy get win get 0 <Window> 0 <int> 0 <int>
0 <uint> 0 <uint> 2dup 2vector >r
0 <uint> 0 <uint>
XGetGeometry drop r> [ *uint ] map ;
: window-width 0 window-size nth ;
: window-height 1 window-size nth ;
: window-position ( -- { x y } )
dpy get win get 0 <Window>
0 <int> 0 <int> 2dup 2vector >r
0 <uint> 0 <uint> 0 <uint> 0 <uint>
XGetGeometry drop r> [ *int ] map ;
: window-x 0 window-position nth ;
: window-y 1 window-position nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 8 - Graphics Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -62,7 +97,7 @@ SYMBOL: white-pixel
! 9 - Window and Session Manager Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: reparent-window ( parent -- ) >r dpy get win get r> 0 0 XReparentWindow ;
: reparent-window ( parent -- ) >r dpy get win get r> 0 0 XReparentWindow drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 11 - Event Handling Functions
@ -72,7 +107,9 @@ SYMBOL: white-pixel
: flush-dpy ( -- ) dpy get XFlush drop ;
: next-event ( -- event ) dpy get <XEvent> dup XNextEvent drop ;
: next-event ( -- event ) dpy get <XEvent> dup >r XNextEvent drop r> ;
: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Not Categorized Yet
@ -87,4 +124,40 @@ SYMBOL: white-pixel
dpy get scr get XRootWindow root set
dpy get scr get XBlackPixel black-pixel set
dpy get scr get XWhitePixel white-pixel set
dpy get scr get XDefaultGC gcontext set ;
dpy get scr get XDefaultGC gcontext set
dpy get scr get XDefaultColormap colormap set ;
: set-window-background ( pixel -- )
>r dpy get win get r> XSetWindowBackground drop ;
: lookup-color ( name -- pixel )
>r dpy get colormap get r> <XColor> dup >r <XColor> XLookupColor drop
dpy get colormap get r> dup >r XAllocColor drop
r> XColor-pixel ;
: window-children ( -- [ child child ... child ] )
dpy get win get 0 <uint> 0 <uint>
0 <uint> <void*> 0 <uint> 2dup >r >r
XQueryTree drop
r> r> ! children-return nchildren-return
swap *void* swap *uint ! children nchildren
[ over uint-nth ] map
swap drop ;
: stack-children ( -- )
window-children
[ [ { 0 0 } move-window ] with-win ]
each ;
: arrange-children-horizontally ( -- )
0
window-children
[ [ dup set-window-x window-width + ] with-win ]
each ;
: arrange-children-vertically ( -- )
0
window-children
[ [ dup set-window-y window-height + ] with-win ]
each ;

138
contrib/x11/xlib.factor
View File

@ -43,6 +43,8 @@ TYPEDEF: int Bool
TYPEDEF: ulong Time
TYPEDEF: void* Window**
!
! 2 - Display Functions
!
@ -170,6 +172,8 @@ FUNCTION: Status XUndefineCursor ( Display* display, Window w ) ;
! 4 - Window Information Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 4.1 - Obtaining Window Information
FUNCTION: Status XQueryTree ( Display* display, Window w, Window* root_return, Window* parent_return, Window** children_return, uint* nchildren_return ) ;
BEGIN-STRUCT: XWindowAttributes
@ -204,8 +208,33 @@ FUNCTION: Status XGetWindowAttributes ( Display* display, Window w, XWindowAttri
: IsUnviewable 1 ;
: IsViewable 2 ;
FUNCTION: Status XGetGeometry (
Display* display,
Drawable d,
Window* root_return,
int* x_return,
int* y_return,
uint* width_return,
uint* height_return,
uint* border_width_return,
uint* depth_return ) ;
! 4.2 - Translating Screen Coordinates
FUNCTION: boolean XQueryPointer ( Display* display, Window w, Window* root_return, Window* child_return, int* root_x_return, int* root_y_return, int* win_x_return, int* win_y_return, uint* mask_return ) ;
! 4.3 - Properties and Atoms
FUNCTION: Atom XInternAtom ( Display* display, char* atom_name, Bool only_if_exists ) ;
FUNCTION: char* XGetAtomName ( Display* display, Atom atom ) ;
! 4.4 - Obtaining and Changing Window Properties
FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, char** prop_return ) ;
FUNCTION: int XChangeProperty ( Display* display, Window w, Atom property, Atom type, int format, int mode, char* data, int nelements ) ;
! 4.5 Selections
FUNCTION: int XSetSelectionOwner ( Display* display, Atom selection, Window owner, Time time ) ;
@ -973,9 +1002,9 @@ BEGIN-UNION: XEvent
! long pad[24];
END-UNION
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 11 - Event Handling Functions
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FUNCTION: Status XSelectInput ( Display* display, Window w, long event_mask ) ;
FUNCTION: Status XFlush ( Display* display ) ;
@ -984,9 +1013,22 @@ FUNCTION: int XPending ( Display* display ) ;
FUNCTION: Status XNextEvent ( Display* display, XEvent* event ) ;
FUNCTION: Status XMaskEvent ( Display* display, long event_mask, XEvent* event_return ) ;
!
! 11.3 - Event Queue Management
: QueuedAlready 0 ;
: QueuedAfterReading 1 ;
: QueuedAfterFlush 2 ;
FUNCTION: int XEventsQueued ( Display* display, int mode ) ;
FUNCTION: int XPending ( Display* display ) ;
! 11.6 - Sending Events to Other Applications
FUNCTION: Status XSendEvent ( Display* display, Window w, Bool propagate, long event_mask, XEvent* event_send ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 12 - Input Device Functions
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FUNCTION: int XGrabPointer ( Display* display, Window grab_window, Bool owner_events, uint event_mask, int pointer_mode, int keyboard_mode, Window confine_to, Cursor cursor, Time time ) ;
FUNCTION: Status XUngrabPointer ( Display* display, Time time ) ;
@ -994,15 +1036,95 @@ FUNCTION: Status XChangeActivePointerGrab ( Display* display, uint event_mask, C
FUNCTION: Status XGrabKey ( Display* display, int keycode, uint modifiers, Window grab_window, Bool owner_events, int pointer_mode, int keyboard_mode ) ;
FUNCTION: Status XSetInputFocus ( Display* display, Window focus, int revert_to, Time time ) ;
FUNCTION: Status XWarpPointer ( Display* display, Window src_w, Window dest_w, int src_x, int src_y, uint src_width, uint src_height, int dest_x, int dest_y ) ;
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 14 - Inter-Client Communication Functions
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FUNCTION: Status XFetchName ( Display* display, Window w, char** window_name_return ) ;
FUNCTION: Status XGetTransientForHint ( Display* display, Window w, Window* prop_window_return ) ;
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 16 - Application Utility Functions
!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FUNCTION: int XLookupString ( XKeyEvent* event_struct, char* buffer_return, int bytes_buffer, KeySym* keysym_return, XComposeStatus* status_in_out ) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: CurrentTime 0 ;
: XA_PRIMARY 1 ;
: XA_SECONDARY 2 ;
: XA_ARC 3 ;
: XA_ATOM 4 ;
: XA_BITMAP 5 ;
: XA_CARDINAL 6 ;
: XA_COLORMAP 7 ;
: XA_CURSOR 8 ;
: XA_CUT_BUFFER0 9 ;
: XA_CUT_BUFFER1 10 ;
: XA_CUT_BUFFER2 11 ;
: XA_CUT_BUFFER3 12 ;
: XA_CUT_BUFFER4 13 ;
: XA_CUT_BUFFER5 14 ;
: XA_CUT_BUFFER6 15 ;
: XA_CUT_BUFFER7 16 ;
: XA_DRAWABLE 17 ;
: XA_FONT 18 ;
: XA_INTEGER 19 ;
: XA_PIXMAP 20 ;
: XA_POINT 21 ;
: XA_RECTANGLE 22 ;
: XA_RESOURCE_MANAGER 23 ;
: XA_RGB_COLOR_MAP 24 ;
: XA_RGB_BEST_MAP 25 ;
: XA_RGB_BLUE_MAP 26 ;
: XA_RGB_DEFAULT_MAP 27 ;
: XA_RGB_GRAY_MAP 28 ;
: XA_RGB_GREEN_MAP 29 ;
: XA_RGB_RED_MAP 30 ;
: XA_STRING 31 ;
: XA_VISUALID 32 ;
: XA_WINDOW 33 ;
: XA_WM_COMMAND 34 ;
: XA_WM_HINTS 35 ;
: XA_WM_CLIENT_MACHINE 36 ;
: XA_WM_ICON_NAME 37 ;
: XA_WM_ICON_SIZE 38 ;
: XA_WM_NAME 39 ;
: XA_WM_NORMAL_HINTS 40 ;
: XA_WM_SIZE_HINTS 41 ;
: XA_WM_ZOOM_HINTS 42 ;
: XA_MIN_SPACE 43 ;
: XA_NORM_SPACE 44 ;
: XA_MAX_SPACE 45 ;
: XA_END_SPACE 46 ;
: XA_SUPERSCRIPT_X 47 ;
: XA_SUPERSCRIPT_Y 48 ;
: XA_SUBSCRIPT_X 49 ;
: XA_SUBSCRIPT_Y 50 ;
: XA_UNDERLINE_POSITION 51 ;
: XA_UNDERLINE_THICKNESS 52 ;
: XA_STRIKEOUT_ASCENT 53 ;
: XA_STRIKEOUT_DESCENT 54 ;
: XA_ITALIC_ANGLE 55 ;
: XA_X_HEIGHT 56 ;
: XA_QUAD_WIDTH 57 ;
: XA_WEIGHT 58 ;
: XA_POINT_SIZE 59 ;
: XA_RESOLUTION 60 ;
: XA_COPYRIGHT 61 ;
: XA_NOTICE 62 ;
: XA_FONT_NAME 63 ;
: XA_FAMILY_NAME 64 ;
: XA_FULL_NAME 65 ;
: XA_CAP_HEIGHT 66 ;
: XA_WM_CLASS 67 ;
: XA_WM_TRANSIENT_FOR 68 ;
: XA_LAST_PREDEFINED 68 ;
: PropModeReplace 0 ;
: PropModePrepend 1 ;
: PropModeAppend 2 ;