Remove >r/r> usage from x11
							parent
							
								
									09c60f7e90
								
							
						
					
					
						commit
						53e3568fa3
					
				| 
						 | 
				
			
			@ -22,14 +22,14 @@ TUPLE: x-clipboard atom contents ;
 | 
			
		|||
    "org.factorcode.Factor.SELECTION" x-atom ;
 | 
			
		||||
 | 
			
		||||
: convert-selection ( win selection -- )
 | 
			
		||||
    swap >r >r dpy get r> XA_UTF8_STRING selection-property r>
 | 
			
		||||
    swap [ [ dpy get ] dip XA_UTF8_STRING selection-property ] dip
 | 
			
		||||
    CurrentTime XConvertSelection drop ;
 | 
			
		||||
 | 
			
		||||
: snarf-property ( prop-return -- string )
 | 
			
		||||
    dup *void* [ *void* ascii alien>string ] [ drop f ] if ;
 | 
			
		||||
 | 
			
		||||
: window-property ( win prop delete? -- string )
 | 
			
		||||
    >r dpy get -rot 0 -1 r> AnyPropertyType
 | 
			
		||||
    [ [ dpy get ] 2dip 0 -1 ] dip AnyPropertyType
 | 
			
		||||
    0 <Atom> 0 <int> 0 <ulong> 0 <ulong> f <void*>
 | 
			
		||||
    [ XGetWindowProperty drop ] keep snarf-property ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -58,7 +58,7 @@ TUPLE: x-clipboard atom contents ;
 | 
			
		|||
    dpy get swap
 | 
			
		||||
    [ XSelectionRequestEvent-requestor ] keep
 | 
			
		||||
    [ XSelectionRequestEvent-property ] keep
 | 
			
		||||
    >r "TIMESTAMP" x-atom 32 PropModeReplace r>
 | 
			
		||||
    [ "TIMESTAMP" x-atom 32 PropModeReplace ] dip
 | 
			
		||||
    XSelectionRequestEvent-time <int>
 | 
			
		||||
    1 XChangeProperty drop ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -71,7 +71,7 @@ TUPLE: x-clipboard atom contents ;
 | 
			
		|||
    over XSelectionRequestEvent-selection over set-XSelectionEvent-selection
 | 
			
		||||
    over XSelectionRequestEvent-target    over set-XSelectionEvent-target
 | 
			
		||||
    over XSelectionRequestEvent-time      over set-XSelectionEvent-time
 | 
			
		||||
    >r dpy get swap XSelectionRequestEvent-requestor 0 0 r>
 | 
			
		||||
    [ dpy get swap XSelectionRequestEvent-requestor 0 0 ] dip
 | 
			
		||||
    XSendEvent drop
 | 
			
		||||
    flush-dpy ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -36,12 +36,12 @@ GENERIC: selection-request-event ( event window -- )
 | 
			
		|||
GENERIC: client-event ( event window -- )
 | 
			
		||||
 | 
			
		||||
: next-event ( -- event )
 | 
			
		||||
    dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ;
 | 
			
		||||
    dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
 | 
			
		||||
 | 
			
		||||
: mask-event ( mask -- event )
 | 
			
		||||
    >r dpy get r> "XEvent" <c-object> dup >r XMaskEvent drop r> ;
 | 
			
		||||
    [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
 | 
			
		||||
 | 
			
		||||
: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ;
 | 
			
		||||
: events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
 | 
			
		||||
 | 
			
		||||
: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -71,15 +71,15 @@ GENERIC: client-event ( event window -- )
 | 
			
		|||
    } case ;
 | 
			
		||||
 | 
			
		||||
: configured-loc ( event -- dim )
 | 
			
		||||
    dup XConfigureEvent-x swap XConfigureEvent-y 2array ;
 | 
			
		||||
    [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
 | 
			
		||||
 | 
			
		||||
: configured-dim ( event -- dim )
 | 
			
		||||
    dup XConfigureEvent-width swap XConfigureEvent-height 2array ;
 | 
			
		||||
    [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
 | 
			
		||||
 | 
			
		||||
: mouse-event-loc ( event -- loc )
 | 
			
		||||
    dup XButtonEvent-x swap XButtonEvent-y 2array ;
 | 
			
		||||
    [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
 | 
			
		||||
 | 
			
		||||
: close-box? ( event -- ? )
 | 
			
		||||
    dup XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom =
 | 
			
		||||
    swap XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom =
 | 
			
		||||
    and ;
 | 
			
		||||
    [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
 | 
			
		||||
    [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]
 | 
			
		||||
    bi and ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -31,7 +31,7 @@ IN: x11.windows
 | 
			
		|||
    "XSetWindowAttributes" <c-object>
 | 
			
		||||
    0 over set-XSetWindowAttributes-background_pixel
 | 
			
		||||
    0 over set-XSetWindowAttributes-border_pixel
 | 
			
		||||
    [ >r create-colormap r> set-XSetWindowAttributes-colormap ] keep
 | 
			
		||||
    [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
 | 
			
		||||
    event-mask over set-XSetWindowAttributes-event_mask ;
 | 
			
		||||
 | 
			
		||||
: set-size-hints ( window -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -43,12 +43,13 @@ IN: x11.windows
 | 
			
		|||
    { 0 0 } = [ drop ] [ set-size-hints ] if ;
 | 
			
		||||
 | 
			
		||||
: create-window ( loc dim visinfo -- window )
 | 
			
		||||
    pick >r
 | 
			
		||||
    >r >r >r dpy get root get r> first2 r> { 1 1 } vmax first2 0 r>
 | 
			
		||||
    [ XVisualInfo-depth InputOutput ] keep
 | 
			
		||||
    [ XVisualInfo-visual create-window-mask ] keep
 | 
			
		||||
    window-attributes XCreateWindow
 | 
			
		||||
    dup r> auto-position ;
 | 
			
		||||
    pick [
 | 
			
		||||
        [ [ [ dpy get root get ] dip first2 ] dip { 1 1 } vmax first2 0 ] dip
 | 
			
		||||
        [ XVisualInfo-depth InputOutput ] keep
 | 
			
		||||
        [ XVisualInfo-visual create-window-mask ] keep
 | 
			
		||||
        window-attributes XCreateWindow
 | 
			
		||||
        dup
 | 
			
		||||
    ] dip auto-position ;
 | 
			
		||||
 | 
			
		||||
: glx-window ( loc dim -- window glx )
 | 
			
		||||
    GLX_DOUBLEBUFFER 1array choose-visual
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue