Fix UI
							parent
							
								
									b712478ee3
								
							
						
					
					
						commit
						0ea519364a
					
				| 
						 | 
				
			
			@ -5,6 +5,8 @@ IN: ui.backend
 | 
			
		|||
 | 
			
		||||
SYMBOL: ui-backend
 | 
			
		||||
 | 
			
		||||
HOOK: do-events ui-backend ( -- )
 | 
			
		||||
 | 
			
		||||
HOOK: set-title ui-backend ( string world -- )
 | 
			
		||||
 | 
			
		||||
HOOK: set-fullscreen* ui-backend ( ? world -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -14,18 +14,8 @@ C: <handle> handle
 | 
			
		|||
 | 
			
		||||
SINGLETON: cocoa-ui-backend
 | 
			
		||||
 | 
			
		||||
SYMBOL: stop-after-last-window?
 | 
			
		||||
 | 
			
		||||
: event-loop? ( -- ? )
 | 
			
		||||
    stop-after-last-window? get-global
 | 
			
		||||
    [ windows get-global empty? not ] [ t ] if ;
 | 
			
		||||
 | 
			
		||||
: event-loop ( -- )
 | 
			
		||||
    event-loop? [
 | 
			
		||||
        [
 | 
			
		||||
            [ NSApp do-events ui-wait ] ui-try
 | 
			
		||||
        ] with-autorelease-pool event-loop
 | 
			
		||||
    ] when ;
 | 
			
		||||
M: cocoa-ui-backend do-events ( -- )
 | 
			
		||||
    [ [ NSApp do-events ui-wait ] ui-try ] with-autorelease-pool ;
 | 
			
		||||
 | 
			
		||||
TUPLE: pasteboard handle ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -112,6 +102,7 @@ M: cocoa-ui-backend ui
 | 
			
		|||
    "UI" assert.app [
 | 
			
		||||
        [
 | 
			
		||||
            init-clipboard
 | 
			
		||||
            stop-after-last-window? off
 | 
			
		||||
            cocoa-init-hook get [ call ] when*
 | 
			
		||||
            start-ui
 | 
			
		||||
            finish-launching
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -10,6 +10,18 @@ IN: ui
 | 
			
		|||
! Assoc mapping aliens to gadgets
 | 
			
		||||
SYMBOL: windows
 | 
			
		||||
 | 
			
		||||
SYMBOL: stop-after-last-window?
 | 
			
		||||
 | 
			
		||||
: event-loop? ( -- ? )
 | 
			
		||||
    {
 | 
			
		||||
        { [ stop-after-last-window? get not ] [ t ] }
 | 
			
		||||
        { [ graft-queue dlist-empty? not ] [ t ] }
 | 
			
		||||
        { [ windows get-global empty? not ] [ t ] }
 | 
			
		||||
        [ f ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
 | 
			
		||||
: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
 | 
			
		||||
 | 
			
		||||
: window ( handle -- world ) windows get-global at ;
 | 
			
		||||
 | 
			
		||||
: window-focus ( handle -- gadget ) window world-focus ;
 | 
			
		||||
| 
						 | 
				
			
			@ -201,5 +213,9 @@ MAIN: ui
 | 
			
		|||
        call
 | 
			
		||||
    ] [
 | 
			
		||||
        f windows set-global
 | 
			
		||||
        ui-hook [ ui ] with-variable
 | 
			
		||||
        [
 | 
			
		||||
            ui-hook set
 | 
			
		||||
            stop-after-last-window? on
 | 
			
		||||
            ui
 | 
			
		||||
        ] with-scope
 | 
			
		||||
    ] if ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -387,17 +387,12 @@ SYMBOL: trace-messages?
 | 
			
		|||
 | 
			
		||||
: peek-message? ( msg -- ? ) f 0 0 PM_REMOVE PeekMessage zero? ;
 | 
			
		||||
 | 
			
		||||
: event-loop ( msg -- )
 | 
			
		||||
    {
 | 
			
		||||
        { [ windows get empty? ] [ drop ] }
 | 
			
		||||
        { [ dup peek-message? ] [ ui-wait event-loop ] }
 | 
			
		||||
        { [ dup MSG-message WM_QUIT = ] [ drop ] }
 | 
			
		||||
        [
 | 
			
		||||
            dup TranslateMessage drop
 | 
			
		||||
            dup DispatchMessage drop
 | 
			
		||||
            event-loop
 | 
			
		||||
        ]
 | 
			
		||||
    } cond ;
 | 
			
		||||
M: windows-ui-backend do-events
 | 
			
		||||
    msg-obj get-global
 | 
			
		||||
    dup peek-message? [ drop ui-wait ] [
 | 
			
		||||
        [ TranslateMessage drop ]
 | 
			
		||||
        [ DispatchMessage drop ] bi
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: register-wndclassex ( -- class )
 | 
			
		||||
    "WNDCLASSEX" <c-object>
 | 
			
		||||
| 
						 | 
				
			
			@ -500,10 +495,11 @@ M: windows-ui-backend set-title ( string world -- )
 | 
			
		|||
M: windows-ui-backend ui
 | 
			
		||||
    [
 | 
			
		||||
        [
 | 
			
		||||
            stop-after-last-window? on
 | 
			
		||||
            init-clipboard
 | 
			
		||||
            init-win32-ui
 | 
			
		||||
            start-ui
 | 
			
		||||
            msg-obj get event-loop
 | 
			
		||||
            event-loop
 | 
			
		||||
        ] [ cleanup-win32-ui ] [ ] cleanup
 | 
			
		||||
    ] ui-running ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -183,15 +183,10 @@ M: world client-event
 | 
			
		|||
        ui-wait wait-event
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: do-events ( -- )
 | 
			
		||||
M: x11-ui-backend do-events
 | 
			
		||||
    wait-event dup XAnyEvent-window window dup
 | 
			
		||||
    [ [ 2dup handle-event ] assert-depth ] when 2drop ;
 | 
			
		||||
 | 
			
		||||
: event-loop ( -- )
 | 
			
		||||
    windows get empty? [
 | 
			
		||||
        [ do-events ] ui-try event-loop
 | 
			
		||||
    ] unless ;
 | 
			
		||||
 | 
			
		||||
: x-clipboard@ ( gadget clipboard -- prop win )
 | 
			
		||||
    x-clipboard-atom swap
 | 
			
		||||
    find-world world-handle x11-handle-window ;
 | 
			
		||||
| 
						 | 
				
			
			@ -254,6 +249,7 @@ M: x11-ui-backend ui ( -- )
 | 
			
		|||
    [
 | 
			
		||||
        f [
 | 
			
		||||
            [
 | 
			
		||||
                stop-after-last-window? on
 | 
			
		||||
                init-clipboard
 | 
			
		||||
                start-ui
 | 
			
		||||
                event-loop
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue